From 9a3edc6af2cd4bd48f6d915c93aa04bb7dcf5880 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:28:27 +0000 Subject: [PATCH 01/61] Can use F,f,T,t for logical init value in registry It was possible to use .false. and .true. for initial values, but these are rather cumbersome in the registry file, so this short form should make it easier without loosing clarity --- modules/openfast-registry/src/registry.hpp | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index 8229622d75..bd194d12a0 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -188,6 +188,14 @@ struct Field else if (init_value.compare("-") != 0) { this->init_value = init_value; + if (tolower(init_value).compare("f") == 0) + { + this->init_value = ".false."; + } + else if (tolower(init_value).compare("t") == 0) + { + this->init_value = ".true."; + } } } From f2595bbdb1a855f75d92587d14d7e79b44138904 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:33:48 +0000 Subject: [PATCH 02/61] Auto gen Registry_NWTC_Library.txt from base/mesh Previously, Registry_NWTC_Library.txt had to be manually generated by concatenating the mesh version and the base version. This makes it automatic in CMake and generates the NWTC_Library_Types.f90. --- modules/nwtc-library/CMakeLists.txt | 9 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 1327 +++++++++++++++++ .../src/Registry_NWTC_Library.txt | 216 ++- .../src/Registry_NWTC_Library_base.txt | 116 ++ ...esh.txt => Registry_NWTC_Library_mesh.txt} | 8 +- .../Registry_NWTC_Library_typedef_nomesh.txt | 40 - 6 files changed, 1600 insertions(+), 116 deletions(-) create mode 100644 modules/nwtc-library/src/Registry_NWTC_Library_base.txt rename modules/nwtc-library/src/{Registry_NWTC_Library_typedef_mesh.txt => Registry_NWTC_Library_mesh.txt} (94%) delete mode 100644 modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 81a39fc2a0..f9d5a7af7a 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -15,7 +15,14 @@ # if (GENERATE_TYPES) - generate_f90_types(src/Registry_NWTC_Library_typedef_nomesh.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) + generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) + # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt + set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS + src/Registry_NWTC_Library_mesh.txt + src/Registry_NWTC_Library_base.txt) # if these files change, rerun configure + file(READ src/Registry_NWTC_Library_base.txt BASE_CONTENTS) + file(READ src/Registry_NWTC_Library_mesh.txt MESH_CONTENTS) + file(WRITE src/Registry_NWTC_Library.txt "${BASE_CONTENTS}\n${MESH_CONTENTS}") endif() #------------------------------------------------------------------------------- diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 13195434b7..254d9b6f50 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -34,6 +34,27 @@ MODULE NWTC_Library_Types USE SysSubs USE ModReg IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_NoLin = 8 ! Variable to be linearized [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 16 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -85,6 +106,70 @@ MODULE NWTC_Library_Types CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= +! ========= ModVarType ======= + TYPE, PUBLIC :: ModVarType + character(VarNameLen) :: Name !< [-] + INTEGER(IntKi) :: Field = 0 !< [-] + INTEGER(IntKi) :: Cat = 0 !< [-] + INTEGER(IntKi) :: Nodes = 1 !< [-] + INTEGER(IntKi) :: Size = 1 !< [-] + INTEGER(IntKi) :: Flags = 0 !< [-] + INTEGER(IntKi) :: DerivOrder = 0 !< [-] + INTEGER(IntKi) :: NumLin = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUsr !< user defined indices for variable [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGbl !< indices in global arrays [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iy !< indices of output to sum for input [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] + END TYPE ModVarType +! ======================= +! ========= ModVarsType ======= + TYPE, PUBLIC :: ModVarsType + INTEGER(IntKi) :: ModNum = 0 !< [-] + character(6) :: ModAbbr !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ixg !< index array mapping local x vector to global x vector [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iug !< index array mapping local u vector to global u vector [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyg !< index array mapping local y vector to global y vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iyu !< index array mapping local y vector to global y vector [-] + END TYPE ModVarsType +! ======================= +! ========= ModValsType ======= + TYPE, PUBLIC :: ModValsType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< input perturbation array [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yn !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + END TYPE ModValsType +! ======================= +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + INTEGER(IntKi) :: ID = 0 !< [-] + character(ChanLen) :: Abbr !< [-] + INTEGER(IntKi) :: Instance = 0 !< [-] + REAL(R8Ki) :: DT = 0 !< [-] + INTEGER(IntKi) :: SubSteps = 0 !< [-] + INTEGER(IntKi) :: SolveOption = 0 !< [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< [-] + TYPE(ModValsType) , POINTER :: Vals => NULL() !< [-] + END TYPE ModDataType +! ======================= CONTAINS subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) @@ -659,5 +744,1247 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%RNG_type) if (RegCheckErr(Buf, RoutineName)) return end subroutine + +subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModVarType), intent(in) :: SrcModVarTypeData + type(ModVarType), intent(inout) :: DstModVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarTypeData%Name = SrcModVarTypeData%Name + DstModVarTypeData%Field = SrcModVarTypeData%Field + DstModVarTypeData%Cat = SrcModVarTypeData%Cat + DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes + DstModVarTypeData%Size = SrcModVarTypeData%Size + DstModVarTypeData%Flags = SrcModVarTypeData%Flags + DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder + DstModVarTypeData%NumLin = SrcModVarTypeData%NumLin + if (allocated(SrcModVarTypeData%iUsr)) then + LB(1:1) = lbound(SrcModVarTypeData%iUsr) + UB(1:1) = ubound(SrcModVarTypeData%iUsr) + if (.not. allocated(DstModVarTypeData%iUsr)) then + allocate(DstModVarTypeData%iUsr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iUsr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr + end if + if (allocated(SrcModVarTypeData%iLoc)) then + LB(1:1) = lbound(SrcModVarTypeData%iLoc) + UB(1:1) = ubound(SrcModVarTypeData%iLoc) + if (.not. allocated(DstModVarTypeData%iLoc)) then + allocate(DstModVarTypeData%iLoc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLoc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc + end if + if (allocated(SrcModVarTypeData%iGbl)) then + LB(1:1) = lbound(SrcModVarTypeData%iGbl) + UB(1:1) = ubound(SrcModVarTypeData%iGbl) + if (.not. allocated(DstModVarTypeData%iGbl)) then + allocate(DstModVarTypeData%iGbl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iGbl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iGbl = SrcModVarTypeData%iGbl + end if + if (allocated(SrcModVarTypeData%iy)) then + LB(1:2) = lbound(SrcModVarTypeData%iy) + UB(1:2) = ubound(SrcModVarTypeData%iy) + if (.not. allocated(DstModVarTypeData%iy)) then + allocate(DstModVarTypeData%iy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iy = SrcModVarTypeData%iy + end if + DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + if (allocated(SrcModVarTypeData%LinNames)) then + LB(1:1) = lbound(SrcModVarTypeData%LinNames) + UB(1:1) = ubound(SrcModVarTypeData%LinNames) + if (.not. allocated(DstModVarTypeData%LinNames)) then + allocate(DstModVarTypeData%LinNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%LinNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%LinNames = SrcModVarTypeData%LinNames + end if +end subroutine + +subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: ModVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarTypeData%iUsr)) then + deallocate(ModVarTypeData%iUsr) + end if + if (allocated(ModVarTypeData%iLoc)) then + deallocate(ModVarTypeData%iLoc) + end if + if (allocated(ModVarTypeData%iGbl)) then + deallocate(ModVarTypeData%iGbl) + end if + if (allocated(ModVarTypeData%iy)) then + deallocate(ModVarTypeData%iy) + end if + if (allocated(ModVarTypeData%LinNames)) then + deallocate(ModVarTypeData%LinNames) + end if +end subroutine + +subroutine NWTC_Library_PackModVarType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ModVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Name) + call RegPack(Buf, InData%Field) + call RegPack(Buf, InData%Cat) + call RegPack(Buf, InData%Nodes) + call RegPack(Buf, InData%Size) + call RegPack(Buf, InData%Flags) + call RegPack(Buf, InData%DerivOrder) + call RegPack(Buf, InData%NumLin) + call RegPack(Buf, allocated(InData%iUsr)) + if (allocated(InData%iUsr)) then + call RegPackBounds(Buf, 1, lbound(InData%iUsr), ubound(InData%iUsr)) + call RegPack(Buf, InData%iUsr) + end if + call RegPack(Buf, allocated(InData%iLoc)) + if (allocated(InData%iLoc)) then + call RegPackBounds(Buf, 1, lbound(InData%iLoc), ubound(InData%iLoc)) + call RegPack(Buf, InData%iLoc) + end if + call RegPack(Buf, allocated(InData%iGbl)) + if (allocated(InData%iGbl)) then + call RegPackBounds(Buf, 1, lbound(InData%iGbl), ubound(InData%iGbl)) + call RegPack(Buf, InData%iGbl) + end if + call RegPack(Buf, allocated(InData%iy)) + if (allocated(InData%iy)) then + call RegPackBounds(Buf, 2, lbound(InData%iy), ubound(InData%iy)) + call RegPack(Buf, InData%iy) + end if + call RegPack(Buf, InData%Perturb) + call RegPack(Buf, allocated(InData%LinNames)) + if (allocated(InData%LinNames)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames), ubound(InData%LinNames)) + call RegPack(Buf, InData%LinNames) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModVarType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ModVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Field) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Nodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Size) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Flags) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DerivOrder) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumLin) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%iUsr)) deallocate(OutData%iUsr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iUsr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iUsr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iUsr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iLoc)) deallocate(OutData%iLoc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iLoc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iLoc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iLoc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iGbl)) deallocate(OutData%iGbl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iGbl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iGbl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iGbl) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iy)) deallocate(OutData%iy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iy) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Perturb) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinNames)) deallocate(OutData%LinNames) + call 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(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: SrcModVarsTypeData + type(ModVarsType), intent(inout) :: DstModVarsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarsTypeData%ModNum = SrcModVarsTypeData%ModNum + DstModVarsTypeData%ModAbbr = SrcModVarsTypeData%ModAbbr + if (allocated(SrcModVarsTypeData%x)) then + LB(1:1) = lbound(SrcModVarsTypeData%x) + UB(1:1) = ubound(SrcModVarsTypeData%x) + if (.not. allocated(DstModVarsTypeData%x)) then + allocate(DstModVarsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%x(i1), DstModVarsTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%u)) then + LB(1:1) = lbound(SrcModVarsTypeData%u) + UB(1:1) = ubound(SrcModVarsTypeData%u) + if (.not. allocated(DstModVarsTypeData%u)) then + allocate(DstModVarsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%u(i1), DstModVarsTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%y)) then + LB(1:1) = lbound(SrcModVarsTypeData%y) + UB(1:1) = ubound(SrcModVarsTypeData%y) + if (.not. allocated(DstModVarsTypeData%y)) then + allocate(DstModVarsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%y(i1), DstModVarsTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx + DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu + DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny + if (allocated(SrcModVarsTypeData%ixg)) then + LB(1:1) = lbound(SrcModVarsTypeData%ixg) + UB(1:1) = ubound(SrcModVarsTypeData%ixg) + if (.not. allocated(DstModVarsTypeData%ixg)) then + allocate(DstModVarsTypeData%ixg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%ix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarsTypeData%ixg = SrcModVarsTypeData%ixg + end if + if (allocated(SrcModVarsTypeData%iug)) then + LB(1:1) = lbound(SrcModVarsTypeData%iug) + UB(1:1) = ubound(SrcModVarsTypeData%iug) + if (.not. allocated(DstModVarsTypeData%iug)) then + allocate(DstModVarsTypeData%iug(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarsTypeData%iug = SrcModVarsTypeData%iug + end if + if (allocated(SrcModVarsTypeData%iyg)) then + LB(1:1) = lbound(SrcModVarsTypeData%iyg) + UB(1:1) = ubound(SrcModVarsTypeData%iyg) + if (.not. allocated(DstModVarsTypeData%iyg)) then + allocate(DstModVarsTypeData%iyg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarsTypeData%iyg = SrcModVarsTypeData%iyg + end if + if (allocated(SrcModVarsTypeData%iyu)) then + LB(1:2) = lbound(SrcModVarsTypeData%iyu) + UB(1:2) = ubound(SrcModVarsTypeData%iyu) + if (.not. allocated(DstModVarsTypeData%iyu)) then + allocate(DstModVarsTypeData%iyu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iyu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarsTypeData%iyu = SrcModVarsTypeData%iyu + end if +end subroutine + +subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: ModVarsTypeData + 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 = 'NWTC_Library_DestroyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarsTypeData%x)) then + LB(1:1) = lbound(ModVarsTypeData%x) + UB(1:1) = ubound(ModVarsTypeData%x) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%x) + end if + if (allocated(ModVarsTypeData%u)) then + LB(1:1) = lbound(ModVarsTypeData%u) + UB(1:1) = ubound(ModVarsTypeData%u) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%u) + end if + if (allocated(ModVarsTypeData%y)) then + LB(1:1) = lbound(ModVarsTypeData%y) + UB(1:1) = ubound(ModVarsTypeData%y) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%y) + end if + if (allocated(ModVarsTypeData%ixg)) then + deallocate(ModVarsTypeData%ixg) + end if + if (allocated(ModVarsTypeData%iug)) then + deallocate(ModVarsTypeData%iug) + end if + if (allocated(ModVarsTypeData%iyg)) then + deallocate(ModVarsTypeData%iyg) + end if + if (allocated(ModVarsTypeData%iyu)) then + deallocate(ModVarsTypeData%iyu) + end if +end subroutine + +subroutine NWTC_Library_PackModVarsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ModVarsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarsType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%ModNum) + call RegPack(Buf, InData%ModAbbr) + 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 NWTC_Library_PackModVarType(Buf, InData%x(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(Buf, InData%u(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(Buf, InData%y(i1)) + end do + end if + call RegPack(Buf, InData%Nx) + call RegPack(Buf, InData%Nu) + call RegPack(Buf, InData%Ny) + call RegPack(Buf, allocated(InData%ixg)) + if (allocated(InData%ixg)) then + call RegPackBounds(Buf, 1, lbound(InData%ixg), ubound(InData%ixg)) + call RegPack(Buf, InData%ixg) + end if + call RegPack(Buf, allocated(InData%iug)) + if (allocated(InData%iug)) then + call RegPackBounds(Buf, 1, lbound(InData%iug), ubound(InData%iug)) + call RegPack(Buf, InData%iug) + end if + call RegPack(Buf, allocated(InData%iyg)) + if (allocated(InData%iyg)) then + call RegPackBounds(Buf, 1, lbound(InData%iyg), ubound(InData%iyg)) + call RegPack(Buf, InData%iyg) + end if + call RegPack(Buf, allocated(InData%iyu)) + if (allocated(InData%iyu)) then + call RegPackBounds(Buf, 2, lbound(InData%iyu), ubound(InData%iyu)) + call RegPack(Buf, InData%iyu) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModVarsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ModVarsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarsType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%ModNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ModAbbr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(Buf, OutData%x(i1)) ! x + end do + end if + 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 NWTC_Library_UnpackModVarType(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%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 NWTC_Library_UnpackModVarType(Buf, OutData%y(i1)) ! y + end do + end if + call RegUnpack(Buf, OutData%Nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Nu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ny) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ixg)) deallocate(OutData%ixg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ixg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ixg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iug)) deallocate(OutData%iug) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iug(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iug) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iyg)) deallocate(OutData%iyg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iyg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iyg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iyu)) deallocate(OutData%iyu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iyu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iyu) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine NWTC_Library_CopyModValsType(SrcModValsTypeData, DstModValsTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModValsType), intent(in) :: SrcModValsTypeData + type(ModValsType), intent(inout) :: DstModValsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModValsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModValsTypeData%x)) then + LB(1:1) = lbound(SrcModValsTypeData%x) + UB(1:1) = ubound(SrcModValsTypeData%x) + if (.not. allocated(DstModValsTypeData%x)) then + allocate(DstModValsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%x = SrcModValsTypeData%x + end if + if (allocated(SrcModValsTypeData%dxdt)) then + LB(1:1) = lbound(SrcModValsTypeData%dxdt) + UB(1:1) = ubound(SrcModValsTypeData%dxdt) + if (.not. allocated(DstModValsTypeData%dxdt)) then + allocate(DstModValsTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dxdt = SrcModValsTypeData%dxdt + end if + if (allocated(SrcModValsTypeData%u)) then + LB(1:1) = lbound(SrcModValsTypeData%u) + UB(1:1) = ubound(SrcModValsTypeData%u) + if (.not. allocated(DstModValsTypeData%u)) then + allocate(DstModValsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%u = SrcModValsTypeData%u + end if + if (allocated(SrcModValsTypeData%y)) then + LB(1:1) = lbound(SrcModValsTypeData%y) + UB(1:1) = ubound(SrcModValsTypeData%y) + if (.not. allocated(DstModValsTypeData%y)) then + allocate(DstModValsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%y = SrcModValsTypeData%y + end if + if (allocated(SrcModValsTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModValsTypeData%u_perturb) + UB(1:1) = ubound(SrcModValsTypeData%u_perturb) + if (.not. allocated(DstModValsTypeData%u_perturb)) then + allocate(DstModValsTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%u_perturb = SrcModValsTypeData%u_perturb + end if + if (allocated(SrcModValsTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModValsTypeData%x_perturb) + UB(1:1) = ubound(SrcModValsTypeData%x_perturb) + if (.not. allocated(DstModValsTypeData%x_perturb)) then + allocate(DstModValsTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%x_perturb = SrcModValsTypeData%x_perturb + end if + if (allocated(SrcModValsTypeData%xp)) then + LB(1:1) = lbound(SrcModValsTypeData%xp) + UB(1:1) = ubound(SrcModValsTypeData%xp) + if (.not. allocated(DstModValsTypeData%xp)) then + allocate(DstModValsTypeData%xp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%xp = SrcModValsTypeData%xp + end if + if (allocated(SrcModValsTypeData%xn)) then + LB(1:1) = lbound(SrcModValsTypeData%xn) + UB(1:1) = ubound(SrcModValsTypeData%xn) + if (.not. allocated(DstModValsTypeData%xn)) then + allocate(DstModValsTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%xn = SrcModValsTypeData%xn + end if + if (allocated(SrcModValsTypeData%yp)) then + LB(1:1) = lbound(SrcModValsTypeData%yp) + UB(1:1) = ubound(SrcModValsTypeData%yp) + if (.not. allocated(DstModValsTypeData%yp)) then + allocate(DstModValsTypeData%yp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%yp = SrcModValsTypeData%yp + end if + if (allocated(SrcModValsTypeData%yn)) then + LB(1:1) = lbound(SrcModValsTypeData%yn) + UB(1:1) = ubound(SrcModValsTypeData%yn) + if (.not. allocated(DstModValsTypeData%yn)) then + allocate(DstModValsTypeData%yn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%yn = SrcModValsTypeData%yn + end if + if (allocated(SrcModValsTypeData%dYdx)) then + LB(1:2) = lbound(SrcModValsTypeData%dYdx) + UB(1:2) = ubound(SrcModValsTypeData%dYdx) + if (.not. allocated(DstModValsTypeData%dYdx)) then + allocate(DstModValsTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dYdx = SrcModValsTypeData%dYdx + end if + if (allocated(SrcModValsTypeData%dXdx)) then + LB(1:2) = lbound(SrcModValsTypeData%dXdx) + UB(1:2) = ubound(SrcModValsTypeData%dXdx) + if (.not. allocated(DstModValsTypeData%dXdx)) then + allocate(DstModValsTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dXdx = SrcModValsTypeData%dXdx + end if + if (allocated(SrcModValsTypeData%dYdu)) then + LB(1:2) = lbound(SrcModValsTypeData%dYdu) + UB(1:2) = ubound(SrcModValsTypeData%dYdu) + if (.not. allocated(DstModValsTypeData%dYdu)) then + allocate(DstModValsTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dYdu = SrcModValsTypeData%dYdu + end if + if (allocated(SrcModValsTypeData%dXdu)) then + LB(1:2) = lbound(SrcModValsTypeData%dXdu) + UB(1:2) = ubound(SrcModValsTypeData%dXdu) + if (.not. allocated(DstModValsTypeData%dXdu)) then + allocate(DstModValsTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dXdu = SrcModValsTypeData%dXdu + end if +end subroutine + +subroutine NWTC_Library_DestroyModValsType(ModValsTypeData, ErrStat, ErrMsg) + type(ModValsType), intent(inout) :: ModValsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModValsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModValsTypeData%x)) then + deallocate(ModValsTypeData%x) + end if + if (allocated(ModValsTypeData%dxdt)) then + deallocate(ModValsTypeData%dxdt) + end if + if (allocated(ModValsTypeData%u)) then + deallocate(ModValsTypeData%u) + end if + if (allocated(ModValsTypeData%y)) then + deallocate(ModValsTypeData%y) + end if + if (allocated(ModValsTypeData%u_perturb)) then + deallocate(ModValsTypeData%u_perturb) + end if + if (allocated(ModValsTypeData%x_perturb)) then + deallocate(ModValsTypeData%x_perturb) + end if + if (allocated(ModValsTypeData%xp)) then + deallocate(ModValsTypeData%xp) + end if + if (allocated(ModValsTypeData%xn)) then + deallocate(ModValsTypeData%xn) + end if + if (allocated(ModValsTypeData%yp)) then + deallocate(ModValsTypeData%yp) + end if + if (allocated(ModValsTypeData%yn)) then + deallocate(ModValsTypeData%yn) + end if + if (allocated(ModValsTypeData%dYdx)) then + deallocate(ModValsTypeData%dYdx) + end if + if (allocated(ModValsTypeData%dXdx)) then + deallocate(ModValsTypeData%dXdx) + end if + if (allocated(ModValsTypeData%dYdu)) then + deallocate(ModValsTypeData%dYdu) + end if + if (allocated(ModValsTypeData%dXdu)) then + deallocate(ModValsTypeData%dXdu) + end if +end subroutine + +subroutine NWTC_Library_PackModValsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ModValsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModValsType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPack(Buf, InData%x) + end if + call RegPack(Buf, allocated(InData%dxdt)) + if (allocated(InData%dxdt)) then + call RegPackBounds(Buf, 1, lbound(InData%dxdt), ubound(InData%dxdt)) + call RegPack(Buf, InData%dxdt) + end if + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + call RegPack(Buf, InData%u) + end if + 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 + call RegPack(Buf, allocated(InData%u_perturb)) + if (allocated(InData%u_perturb)) then + call RegPackBounds(Buf, 1, lbound(InData%u_perturb), ubound(InData%u_perturb)) + call RegPack(Buf, InData%u_perturb) + end if + call RegPack(Buf, allocated(InData%x_perturb)) + if (allocated(InData%x_perturb)) then + call RegPackBounds(Buf, 1, lbound(InData%x_perturb), ubound(InData%x_perturb)) + call RegPack(Buf, InData%x_perturb) + end if + call RegPack(Buf, allocated(InData%xp)) + if (allocated(InData%xp)) then + call RegPackBounds(Buf, 1, lbound(InData%xp), ubound(InData%xp)) + call RegPack(Buf, InData%xp) + end if + call RegPack(Buf, allocated(InData%xn)) + if (allocated(InData%xn)) then + call RegPackBounds(Buf, 1, lbound(InData%xn), ubound(InData%xn)) + call RegPack(Buf, InData%xn) + end if + call RegPack(Buf, allocated(InData%yp)) + if (allocated(InData%yp)) then + call RegPackBounds(Buf, 1, lbound(InData%yp), ubound(InData%yp)) + call RegPack(Buf, InData%yp) + end if + call RegPack(Buf, allocated(InData%yn)) + if (allocated(InData%yn)) then + call RegPackBounds(Buf, 1, lbound(InData%yn), ubound(InData%yn)) + call RegPack(Buf, InData%yn) + end if + call RegPack(Buf, allocated(InData%dYdx)) + if (allocated(InData%dYdx)) then + call RegPackBounds(Buf, 2, lbound(InData%dYdx), ubound(InData%dYdx)) + call RegPack(Buf, InData%dYdx) + end if + call RegPack(Buf, allocated(InData%dXdx)) + if (allocated(InData%dXdx)) then + call RegPackBounds(Buf, 2, lbound(InData%dXdx), ubound(InData%dXdx)) + call RegPack(Buf, InData%dXdx) + end if + call RegPack(Buf, allocated(InData%dYdu)) + if (allocated(InData%dYdu)) then + call RegPackBounds(Buf, 2, lbound(InData%dYdu), ubound(InData%dYdu)) + call RegPack(Buf, InData%dYdu) + end if + call RegPack(Buf, allocated(InData%dXdu)) + if (allocated(InData%dXdu)) then + call RegPackBounds(Buf, 2, lbound(InData%dXdu), ubound(InData%dXdu)) + call RegPack(Buf, InData%dXdu) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModValsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ModValsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModValsType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dxdt)) deallocate(OutData%dxdt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dxdt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dxdt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 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 + call RegUnpack(Buf, OutData%u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%u_perturb)) deallocate(OutData%u_perturb) + call 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_perturb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_perturb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%u_perturb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_perturb)) deallocate(OutData%x_perturb) + call 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_perturb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_perturb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_perturb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%xp)) deallocate(OutData%xp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%xn)) deallocate(OutData%xn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%yp)) deallocate(OutData%yp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%yp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%yp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%yp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%yn)) deallocate(OutData%yn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%yn(LB(1):UB(1)),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 + if (allocated(OutData%dYdx)) deallocate(OutData%dYdx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dYdx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dYdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dYdx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dXdx)) deallocate(OutData%dXdx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dXdx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dXdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dXdx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dYdu)) deallocate(OutData%dYdu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dYdu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dYdu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dYdu) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dXdu)) deallocate(OutData%dXdu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dXdu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dXdu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dXdu) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: SrcModDataTypeData + type(ModDataType), intent(inout) :: DstModDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(0), UB(0) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%Instance = SrcModDataTypeData%Instance + DstModDataTypeData%DT = SrcModDataTypeData%DT + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + DstModDataTypeData%SolveOption = SrcModDataTypeData%SolveOption + DstModDataTypeData%Vars => SrcModDataTypeData%Vars + DstModDataTypeData%Vals => SrcModDataTypeData%Vals +end subroutine + +subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(ModDataTypeData%Vars) + nullify(ModDataTypeData%Vals) +end subroutine + +subroutine NWTC_Library_PackModDataType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ModDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%ID) + call RegPack(Buf, InData%Abbr) + call RegPack(Buf, InData%Instance) + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%SubSteps) + call RegPack(Buf, InData%SolveOption) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if + call RegPack(Buf, associated(InData%Vals)) + if (associated(InData%Vals)) then + call RegPackPointer(Buf, c_loc(InData%Vals), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModValsType(Buf, InData%Vals) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModDataType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ModDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' + integer(IntKi) :: LB(0), UB(0) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%ID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Abbr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Instance) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SubSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SolveOption) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + if (associated(OutData%Vals)) deallocate(OutData%Vals) + 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%Vals) + else + allocate(OutData%Vals,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vals) + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals + end if + else + OutData%Vals => null() + end if +end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index a77c60c073..ff96a7c199 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -1,71 +1,151 @@ +# This file defines types that may be used from the NWTC_Library +# include this into a component registry file if you wish to use these types + +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" + +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" + +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" + +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} + +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} + +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type + +#------------------------------------------------------------------------------- +# Module Variables +#------------------------------------------------------------------------------- + +param ^ - IntKi VarNameLen - 64 - "" - + +param ^ - IntKi VF_Force - 1 - "" - +param ^ - IntKi VF_Moment - 2 - "" - +param ^ - IntKi VF_Orientation - 3 - "" - +param ^ - IntKi VF_TransDisp - 4 - "" - +param ^ - IntKi VF_AngularDisp - 5 - "" - +param ^ - IntKi VF_TransVel - 6 - "" - +param ^ - IntKi VF_AngularVel - 7 - "" - +param ^ - IntKi VF_TransAcc - 8 - "" - +param ^ - IntKi VF_AngularAcc - 9 - "" - +param ^ - IntKi VF_Scalar - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_NoLin - 8 - "Variable to be linearized" - +param ^ - IntKi VF_Ext - 16 - "Variable for extended linearization" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Cat - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Size - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi NumLin - 0 - "" - +typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iGbl : - - "indices in global arrays" - +typedef ^ ^ IntKi iy :: - - "indices of output to sum for input" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "" - +typedef ^ ^ ModVarType u : - - "" - +typedef ^ ^ ModVarType y : - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ IntKi ixg : - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi iug : - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iyg : - - "index array mapping local y vector to global y vector" - +typedef ^ ^ IntKi iyu :: - - "index array mapping local y vector to global y vector" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi ID - 0 - "" - +typedef ^ ^ character(ChanLen) Abbr - - - "" - +typedef ^ ^ IntKi Instance - 0 - "" - +typedef ^ ^ R8Ki DT - 0 - "" - +typedef ^ ^ IntKi SubSteps - 0 - "" - +typedef ^ ^ IntKi SolveOption - 0 - "" - +typedef ^ ^ ModVarsType *Vars - - - "" - +typedef ^ ^ ModValsType *Vals - - - "" - + # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types -# the "usefrom" keyword defines the types for the registry without generating -# a NWTC_Library_Types.f90 file -# -#............................................................. - - -usefrom NWTC_Library ProgDesc CHARACTER(99) Name -usefrom ^ ^ CHARACTER(99) Ver -usefrom ^ ^ CHARACTER(24) Date - -usefrom ^ FASTdataType CHARACTER(1024) File -usefrom ^ ^ CHARACTER(1024) Descr -usefrom ^ ^ IntKi NumChans -usefrom ^ ^ IntKi NumRecs -usefrom ^ ^ DbKi TimeStep -usefrom ^ ^ CHARACTER(ChanLen) ChanNames {:} -usefrom ^ ^ CHARACTER(ChanLen) ChanUnits {:} -usefrom ^ ^ ReKi Data {:}{:} - -usefrom NWTC_Library OutParmType IntKi Indx -usefrom ^ ^ CHARACTER(ChanLen) Name -usefrom ^ ^ CHARACTER(ChanLen) Units -usefrom ^ ^ IntKi SignM - -usefrom NWTC_Library FileInfoType IntKi NumLines -usefrom ^ ^ IntKi NumFiles -usefrom ^ ^ IntKi FileLine {:} -usefrom ^ ^ IntKi FileIndx {:} -usefrom ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} -usefrom ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} - -usefrom NWTC_Library Quaternion ReKi q0 -usefrom ^ ^ ReKi v {3} - -usefrom NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -usefrom ^ ^ IntKi RandSeed {3} -usefrom ^ ^ IntKi RandSeedAry {:} -usefrom ^ ^ CHARACTER(6) RNG_type - -#BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 -usefrom NWTC_Library MapType IntKi OtherMesh_Element -usefrom ^ ^ R8Ki distance - -usefrom ^ ^ R8Ki couple_arm {3} -usefrom ^ ^ R8Ki shape_fn {2} - -usefrom NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} -usefrom ^ ^ R8Ki fx_p {:}{:} -usefrom ^ ^ R8Ki tv_uD {:}{:} -usefrom ^ ^ R8Ki tv_uS {:}{:} -usefrom ^ ^ R8Ki ta_uD {:}{:} -usefrom ^ ^ R8Ki ta_uS {:}{:} -usefrom ^ ^ R8Ki ta_rv {:}{:} -usefrom ^ ^ R8Ki li {:}{:} -usefrom ^ ^ R8Ki M_u {:}{:} -usefrom ^ ^ R8Ki M_t {:}{:} -usefrom ^ ^ R8Ki M_f {:}{:} - -usefrom NWTC_Library MeshMapType MapType MapLoads {:} -usefrom ^ ^ MapType MapMotions {:} -usefrom ^ ^ MapType MapSrcToAugmt {:} -usefrom ^ ^ MeshType Augmented_Ln2_Src - -usefrom ^ ^ MeshType Lumped_Points_Src - -usefrom ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} -usefrom ^ ^ R8Ki DisplacedPosition {:}{:}{:} -usefrom ^ ^ R8Ki LoadLn2_A_Mat {:}{:} -usefrom ^ ^ R8Ki LoadLn2_F {:}{:} -usefrom ^ ^ R8Ki LoadLn2_M {:}{:} -usefrom ^ ^ MeshMapLinearizationType dM +#BJJ: the following three types are in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 + +typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" +typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m +typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m +typedef ^ ^ R8Ki shape_fn {2} - - "shape functions: 1-D element-level location [0,1] based on closest-line projection of point" - + +typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" +typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" +typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" +typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" +typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" +typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" +typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" + +typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for load fields on the mesh" +typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motion and/or scalar fields on the mesh" +typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination" +typedef ^ ^ MeshType Augmented_Ln2_Src - - - "temporary mesh for storing augmented line2 source values" +typedef ^ ^ MeshType Lumped_Points_Src - - - "temporary mesh for lumping lines to points, stored here for efficiency" +typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorization of LoadLn2_A_Mat" +typedef ^ ^ R8Ki DisplacedPosition {:}{:}{:} - - "couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency)" m +typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" +typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ MeshMapLinearizationType dM +#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt new file mode 100644 index 0000000000..84f0f80f09 --- /dev/null +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -0,0 +1,116 @@ +# This file defines types that may be used from the NWTC_Library +# include this into a component registry file if you wish to use these types + +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" + +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" + +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" + +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} + +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} + +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type + +#------------------------------------------------------------------------------- +# Module Variables +#------------------------------------------------------------------------------- + +param ^ - IntKi VarNameLen - 64 - "" - + +param ^ - IntKi VF_Force - 1 - "" - +param ^ - IntKi VF_Moment - 2 - "" - +param ^ - IntKi VF_Orientation - 3 - "" - +param ^ - IntKi VF_TransDisp - 4 - "" - +param ^ - IntKi VF_AngularDisp - 5 - "" - +param ^ - IntKi VF_TransVel - 6 - "" - +param ^ - IntKi VF_AngularVel - 7 - "" - +param ^ - IntKi VF_TransAcc - 8 - "" - +param ^ - IntKi VF_AngularAcc - 9 - "" - +param ^ - IntKi VF_Scalar - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_NoLin - 8 - "Variable to be linearized" - +param ^ - IntKi VF_Ext - 16 - "Variable for extended linearization" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Cat - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Size - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi NumLin - 0 - "" - +typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iGbl : - - "indices in global arrays" - +typedef ^ ^ IntKi iy :: - - "indices of output to sum for input" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "" - +typedef ^ ^ ModVarType u : - - "" - +typedef ^ ^ ModVarType y : - - "" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - +typedef ^ ^ IntKi ixg : - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi iug : - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iyg : - - "index array mapping local y vector to global y vector" - +typedef ^ ^ IntKi iyu :: - - "index array mapping local y vector to global y vector" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi ID - 0 - "" - +typedef ^ ^ character(ChanLen) Abbr - - - "" - +typedef ^ ^ IntKi Instance - 0 - "" - +typedef ^ ^ R8Ki DT - 0 - "" - +typedef ^ ^ IntKi SubSteps - 0 - "" - +typedef ^ ^ IntKi SolveOption - 0 - "" - +typedef ^ ^ ModVarsType *Vars - - - "" - +typedef ^ ^ ModValsType *Vals - - - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt similarity index 94% rename from modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt rename to modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt index e1720a4772..d175a75557 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt @@ -1,13 +1,7 @@ # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types -# the "usefrom" keyword defines the types for the registry without generating -# a NWTC_Library_Types.f90 file -# -#............................................................. +#BJJ: the following three types are in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 - - -#BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt deleted file mode 100644 index 40cdaee1b9..0000000000 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt +++ /dev/null @@ -1,40 +0,0 @@ -# This file defines types that may be used from the NWTC_Library -# include this into a component registry file if you wish to use these types -# the "usefrom" keyword defines the types for the registry without generating -# a NWTC_Library_Types.f90 file -# -#............................................................. - - -typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" -typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" -typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" - -typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" -typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" -typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" -typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" -typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" -typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" -typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" -typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" - -typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" -typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" - -typedef NWTC_Library FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} -typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} -typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} - -typedef NWTC_Library Quaternion ReKi q0 -typedef ^ ^ ReKi v {3} - -typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type From f6da687b5e04fa7c941988c5779346dcaf70d356 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:35:03 +0000 Subject: [PATCH 03/61] Add ModVar for module variables to NWTC Library This package manages module variables and values that are used by the solver and linearization. --- modules/nwtc-library/CMakeLists.txt | 1 + modules/nwtc-library/src/ModVar.f90 | 691 ++++++++++++++++++++++ modules/nwtc-library/src/NWTC_Library.f90 | 1 + 3 files changed, 693 insertions(+) create mode 100644 modules/nwtc-library/src/ModVar.f90 diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index f9d5a7af7a..1c30b63202 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -67,6 +67,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 src/ModReg.f90 + src/ModVar.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 new file mode 100644 index 0000000000..a62e41470a --- /dev/null +++ b/modules/nwtc-library/src/ModVar.f90 @@ -0,0 +1,691 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2023 National Renewable Energy Laboratory +! +! This file is part of the NWTC Subroutine Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> The modules ModVar and ModVar_Types provide data structures and subroutines for representing and manipulating meshes +!! and meshed data in the FAST modular framework. +!! +!! Module variables provide a structured way for documenting, locating, and orchestrating the interdependencies between modules. +!! + +module ModVar +use NWTC_Library_Types +use NWTC_IO +use ModMesh +implicit none + +private + +integer(IntKi), parameter :: & + LoadFields(*) = [VF_Force, VF_Moment], & + TransFields(*) = [VF_TransDisp, VF_TransVel, VF_TransAcc], & + AngularFields(*) = [VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & + MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc] + +public :: MV_InitVars, MV_LinkOutputInput, MV_VarIndex, MV_PackMesh, MV_UnpackMesh +public :: MV_ComputeCentralDiff, MV_Perturb +public :: MV_AddVar, MV_AddMeshVar, MV_AddModule +public :: LoadFields, MotionFields, TransFields, AngularFields +public :: wm_to_dcm, MV_CollectGlobalIndices, wm_compose + +contains + +subroutine MV_Perturb(Var, iLin, PerturbSign, BaseArr, PerturbArr, iPerturb) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: iLin + integer(IntKi), intent(in) :: PerturbSign + real(R8Ki), intent(in) :: BaseArr(:) + real(R8Ki), intent(inout) :: PerturbArr(:) + integer(IntKi), intent(out) :: iPerturb + real(R8Ki) :: Perturb + real(R8Ki) :: WM(3), WMp(3) + integer(IntKi) :: i, j, iLocArr(3) + + ! Copy base array to perturbed array + PerturbArr = BaseArr + + ! Get variable perturbation and combine with sign + Perturb = Var%Perturb*real(PerturbSign, R8Ki) + + ! Perturbation index within array + iPerturb = Var%iLoc(iLin) + + ! If variable is in a mesh and field is orientation + if (Var%Field == VF_Orientation) then + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = iLin - j ! index of start of WM parameters (3) + iLocArr = Var%iLoc(i:i + 2) ! array index vector + WMp = 0.0_R8Ki ! Init WM perturbation to zero + WMp(j + 1) = 4*tan(Perturb/4.0_R8Ki) ! WM perturbation around X,Y,Z axis + WM = PerturbArr(iLocArr) ! Current WM parameters value + PerturbArr(iLocArr) = wm_compose(WM, WMp) ! Compose value and perturbation + else + PerturbArr(Var%iLoc(iLin)) = PerturbArr(Var%iLoc(iLin)) + Perturb + end if + +end subroutine + +subroutine MV_InitVars(Vars, Vals, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: Vars + type(ModValsType), pointer, intent(inout) :: Vals + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_InitMod' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, StartIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize state variables + StartIndex = 1 + do i = 1, size(Vars%x) + call ModVarType_Init(Vars%x(i), StartIndex, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Initialize input variables + StartIndex = 1 + do i = 1, size(Vars%u) + call ModVarType_Init(Vars%u(i), StartIndex, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Initialize output variables + StartIndex = 1 + do i = 1, size(Vars%y) + call ModVarType_Init(Vars%y(i), StartIndex, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Calculate number of variables in group (exclude non linearization vars) + Vars%Nx = sum(Vars%x%Size, iand(Vars%x%Flags, VF_NoLin) == 0) + Vars%Nu = sum(Vars%u%Size, iand(Vars%u%Flags, VF_NoLin) == 0) + Vars%Ny = sum(Vars%y%Size, iand(Vars%y%Flags, VF_NoLin) == 0) + + call AllocAry(Vars%ixg, Vars%Nx, "Vars%ixg", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vars%iug, Vars%Nu, "Vars%iug", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vars%iyg, Vars%Ny, "Vars%iyg", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate Vals derived type + allocate (Vals, stat=ErrStat2); if (FailedAlloc()) return + + ! Allocate state, input, and output values + call AllocAry(Vals%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%dxdt, Vars%Nx, "Vals%dxdt", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%u, Vars%Nu, "Vals%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%y, Vars%Ny, "Vals%y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate perturbation input and output values + call AllocAry(Vals%u_perturb, Vars%Nu, "Vals%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%x_perturb, Vars%Nx, "Vals%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%xp, Vars%Nx, "Vals%xp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%xn, Vars%Nx, "Vals%xn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%yp, Vars%Ny, "Vals%yp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%yn, Vars%Ny, "Vals%yn", ErrStat2, ErrMsg2); if (Failed()) return + +contains + + function Failed() + logical Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + function FailedAlloc() + logical FailedAlloc + FailedAlloc = ErrStat2 /= 0 + if (FailedAlloc) call SetErrStat(ErrID_Fatal, 'error allocating Vals', ErrStat, ErrMsg, RoutineName) + end function + +end subroutine + +subroutine MV_CollectGlobalIndices(VarArr, iGbl) + type(ModVarType), intent(in) :: VarArr(:) + integer(IntKi), intent(out) :: iGbl(:) + integer(IntKi) :: i + do i = 1, size(VarArr) + iGbl(VarArr(i)%iLoc) = VarArr(i)%iGbl + end do +end subroutine + +elemental function IsMesh(Var) result(r) + type(ModVarType), intent(in) :: Var + logical :: r + r = iand(Var%Flags, VF_Mesh) > 0 +end function + +subroutine ModVarType_Init(Var, Index, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(inout) :: Index + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModVarsType_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + integer(IntKi) :: nNodes + character(1), parameter :: Comp(3) = ['X', 'Y', 'Z'] + character(*), parameter :: Fmt = '(A," ",A,", node",I0,", ",A)' + character(2) :: UnitDesc + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Basic Variable + !---------------------------------------------------------------------------- + + Var%NumLin = Var%Size + + !---------------------------------------------------------------------------- + ! Mesh + !---------------------------------------------------------------------------- + + ! If this variable belongs to a mesh + if (iand(Var%Flags, VF_Mesh) > 0) then + + ! Size is the number of nodes in a mesh + Var%Nodes = Var%Size + + ! Number of linearization values + Var%NumLin = Var%Nodes*3 + Var%Size = Var%Nodes*3 + + ! Set unit description for line mesh + UnitDesc = '' + if (iand(Var%Flags, VF_Line) > 0) UnitDesc = "/m" + + ! Switch based on field number + select case (Var%Field) + case (VF_Force) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_Moment) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_TransDisp) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, nNodes)] + case (VF_Orientation) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, nNodes)] + case (VF_TransVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, nNodes)] + case (VF_AngularVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, nNodes)] + case (VF_TransAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, nNodes)] + case (VF_AngularAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, nNodes)] + case default + call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) + return + end select + + end if + + !---------------------------------------------------------------------------- + ! No Linearization + !---------------------------------------------------------------------------- + + if (iand(Var%Flags, VF_NoLin) > 0) then ! No Linearization + + ! Number of linearization values is zero if NoLin flag is set + Var%NumLin = 0 + + else + + ! If insufficient linearization names, return error + if (size(Var%LinNames) < Var%NumLin) then + call SetErrStat(ErrID_Fatal, "insufficient LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Indices + !---------------------------------------------------------------------------- + + ! Initialize local index + call AllocAry(Var%iLoc, Var%Size, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return + Var%iLoc = [(index + i, i=0, Var%Size - 1)] + + ! Initialize global index + call AllocAry(Var%iGbl, Var%Size, "Var%iGbl", ErrStat2, ErrMsg2); if (Failed()) return + Var%iGbl = 0 + + ! Update index based on variable size + index = index + Var%Size + + !---------------------------------------------------------------------------- + ! Derivative Order + !---------------------------------------------------------------------------- + + select case (Var%Field) + case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position + Var%DerivOrder = 0 + case (VF_TransVel, VF_AngularVel) ! Velocity + Var%DerivOrder = 1 + case (VF_TransAcc, VF_AngularAcc) ! Acceleration + Var%DerivOrder = 2 + case default + Var%DerivOrder = -1 + end select + + !---------------------------------------------------------------------------- + ! Module Index + !---------------------------------------------------------------------------- + + ! If module index has been allocated and size does not mach variable size, return error + if (allocated(Var%iUsr)) then + if (size(Var%iUsr) < Var%Size) then + call SetErrStat(ErrID_Fatal, "insufficient iMod given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + end if + end if + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine MV_PackMesh(VarArr, Mesh, arr) + type(ModVarType), intent(in) :: VarArr(:) + type(MeshType), intent(in) :: Mesh + real(R8Ki), intent(inout) :: arr(:) + integer(IntKi) :: i, j + do i = 1, size(VarArr) + select case (VarArr(i)%Field) + case (VF_Force) + arr(VarArr(i)%iLoc) = pack(Mesh%Force, .true.) + case (VF_Moment) + arr(VarArr(i)%iLoc) = pack(Mesh%Moment, .true.) + case (VF_TransDisp) + arr(VarArr(i)%iLoc) = pack(Mesh%TranslationDisp, .true.) + case (VF_Orientation) + do j = 1, VarArr(i)%Nodes + arr(VarArr(i)%iLoc(3*(j - 1) + 1:3*j)) = wm_from_dcm(Mesh%Orientation(:, :, j)) + end do + case (VF_TransVel) + arr(VarArr(i)%iLoc) = pack(Mesh%TranslationVel, .true.) + case (VF_AngularVel) + arr(VarArr(i)%iLoc) = pack(Mesh%RotationVel, .true.) + case (VF_TransAcc) + arr(VarArr(i)%iLoc) = pack(Mesh%TranslationAcc, .true.) + case (VF_AngularAcc) + arr(VarArr(i)%iLoc) = pack(Mesh%RotationAcc, .true.) + case (VF_Scalar) + arr(VarArr(i)%iLoc) = pack(Mesh%Scalars, .true.) + end select + end do +end subroutine + +subroutine MV_UnpackMesh(VarArr, arr, Mesh) + type(ModVarType), intent(in) :: VarArr(:) + real(R8Ki), intent(in) :: arr(:) + type(MeshType), intent(inout) :: Mesh + integer(IntKi) :: i, j + do i = 1, size(VarArr) + select case (VarArr(i)%Field) + case (VF_Force) + Mesh%Force = reshape(arr(VarArr(i)%iLoc), shape(Mesh%Force)) + case (VF_Moment) + Mesh%Moment = reshape(arr(VarArr(i)%iLoc), shape(Mesh%Moment)) + case (VF_TransDisp) + Mesh%TranslationDisp = reshape(arr(VarArr(i)%iLoc), shape(Mesh%TranslationDisp)) + case (VF_Orientation) + do j = 1, VarArr(i)%Nodes + Mesh%Orientation(:, :, j) = wm_to_dcm(arr(VarArr(i)%iLoc(3*(j - 1) + 1:3*j))) + end do + case (VF_TransVel) + Mesh%TranslationVel = reshape(arr(VarArr(i)%iLoc), shape(Mesh%TranslationVel)) + case (VF_AngularVel) + Mesh%RotationVel = reshape(arr(VarArr(i)%iLoc), shape(Mesh%RotationVel)) + case (VF_TransAcc) + Mesh%TranslationAcc = reshape(arr(VarArr(i)%iLoc), shape(Mesh%TranslationAcc)) + case (VF_AngularAcc) + Mesh%RotationAcc = reshape(arr(VarArr(i)%iLoc), shape(Mesh%RotationAcc)) + case (VF_Scalar) + Mesh%Scalars = reshape(arr(VarArr(i)%iLoc), shape(Mesh%Scalars)) + end select + end do +end subroutine + +subroutine MV_ComputeCentralDiff(VarArr, Delta, PosArr, NegArr, DerivArr) + type(ModVarType), intent(in) :: VarArr(:) ! Array of variables + real(R8Ki), intent(in) :: Delta ! Positive perturbation value + real(R8Ki), intent(in) :: PosArr(:) ! Positive perturbation result array + real(R8Ki), intent(in) :: NegArr(:) ! Negative perturbation result array + real(R8Ki), intent(inout) :: DerivArr(:) ! Array containing derivative + integer(IntKi) :: i, j, rloc(3) + real(R8Ki) :: WMp(3), WMn(3) + + ! Compute difference between all values + DerivArr = PosArr - NegArr + + ! Loop through variables + do i = 1, size(VarArr) + + ! If variable is mesh rotation + if (VarArr(i)%Field == VF_Orientation) then + + ! Loop through nodes + do j = 1, VarArr(i)%Nodes + + ! Get vector of indicies of WM rotation parameters in array + rloc = VarArr(i)%iLoc(3*(j - 1) + 1:3*j) + + ! Get rotation from positive and negative perturbation + WMp = PosArr(rloc) + WMn = NegArr(rloc) + + ! Calculate change in rotation and add to array + DerivArr(rloc) = wm_compose(wm_inv(WMn), WMp) + ! arrDelta(rloc) = wm_to_zyx(wm_compose(wm_inv(WMn), WMp)) + end do + end if + end do + + ! Divide array by 2*delta + DerivArr = DerivArr/(2.0_R8Ki*Delta) + +end subroutine + +!------------------------------------------------------------------------------- +! Functions for adding Variables an Modules +!------------------------------------------------------------------------------- + +subroutine MV_AddModule(ModArr, ModID, ModAbbr, Instance, DT, Vars, Vals) + type(ModDataType), allocatable, intent(inout) :: ModArr(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: DT + type(ModVarsType), pointer, intent(in) :: Vars + type(ModValsType), pointer, intent(in) :: Vals + type(ModDataType) :: MData + MData = ModDataType(ID=ModID, Abbr=ModAbbr, Instance=Instance, DT=DT, Vars=Vars, Vals=Vals) + if (allocated(ModArr)) then + ModArr = [ModArr, MData] + else + ModArr = [MData] + end if +end subroutine + +subroutine MV_AddMeshVar(VarArr, Name, Fields, Nodes, Flags, Perturbs, Active) + type(ModVarType), allocatable, intent(inout) :: VarArr(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Fields(:) + integer(IntKi), optional, intent(in) :: Nodes, Flags + real(R8Ki), optional, intent(in) :: Perturbs(:) + logical, optional, intent(in) :: Active + integer(IntKi) :: i, NodesLocal, FlagsLocal + logical :: ActiveLocal + real(R8Ki), allocatable :: PerturbsLocal(:) + NodesLocal = 1 + if (present(Nodes)) NodesLocal = Nodes + FlagsLocal = 0 + if (present(Flags)) FlagsLocal = Flags + FlagsLocal = ior(FlagsLocal, VF_Mesh) + PerturbsLocal = [(0.0_R8Ki, i=1, size(Fields))] + if (present(Perturbs)) PerturbsLocal = Perturbs + ActiveLocal = .true. + if (present(Active)) ActiveLocal = Active + do i = 1, size(Fields) + call MV_AddVar(VarArr, Name, Fields(i), Num=NodesLocal, Flags=FlagsLocal, & + Perturb=PerturbsLocal(i), Active=ActiveLocal) + end do +end subroutine + +subroutine MV_AddVar(VarArr, Name, Field, Num, Flags, iUsr, Perturb, LinNames, Active) + type(ModVarType), allocatable, intent(inout) :: VarArr(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + integer(IntKi), optional, intent(in) :: Num, Flags, iUsr(:) + real(R8Ki), optional, intent(in) :: Perturb + logical, optional, intent(in) :: Active + character(*), optional, intent(in) :: LinNames(:) + integer(IntKi) :: i + type(ModVarType) :: Var + + ! If active argument specified and not active, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize var with default values + Var = ModVarType(Name=Name, Field=Field) + + ! Set optional values + if (present(Num)) Var%Size = Num + if (present(Flags)) Var%Flags = Flags + if (present(iUsr)) Var%iUsr = iUsr + if (present(Perturb)) Var%Perturb = Perturb + if (present(LinNames)) then + allocate (Var%LinNames(size(LinNames))) + do i = 1, size(LinNames) + Var%LinNames(i) = LinNames(i) + end do + end if + + if (allocated(VarArr)) then + VarArr = [VarArr, Var] + else + VarArr = [Var] + end if +end subroutine + +function MV_VarIndex(VarArr, Name, Field) result(Indx) + type(ModVarType), intent(in) :: VarArr(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + integer(IntKi) :: Indx + do Indx = 1, size(VarArr) + if (string_equal_ci(VarArr(Indx)%Name, Name) .and. & + VarArr(Indx)%Field == Field) exit + end do + if (Indx > size(VarArr)) Indx = 0 +end function + +!------------------------------------------------------------------------------- +! Functions for linking variables (Output and Input) +!------------------------------------------------------------------------------- + +subroutine MV_LinkOutputInput(OutVars, InpVars, OutName, InpName, Field, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: OutVars, InpVars + character(*), intent(in) :: OutName, InpName + integer(IntKi), intent(in) :: Field + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_LinkOutputInput' + ! integer(IntKi) :: ErrStat2 + ! character(ErrMsgLen) :: ErrMsg2 + ! integer(IntKi) :: i + integer(IntKi) :: InpVarIndex, OutVarIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Find name/field in input vars + InpVarIndex = MV_VarIndex(InpVars%u, InpName, Field) + if (InpVarIndex == 0) then + call SetErrStat(ErrID_Fatal, 'Input variable "'//InpName//'" with field '// & + trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Find name/field in output vars + OutVarIndex = MV_VarIndex(OutVars%u, OutName, Field) + if (OutVarIndex == 0) then + call SetErrStat(ErrID_Fatal, 'Output variable "'//OutName//'" with field '// & + trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) + return + end if + + ! If error finding input or output variable, return + if (ErrStat >= AbortErrLev) return + + ! TODO: figure out what to do here + +end subroutine + +!------------------------------------------------------------------------------- +! String Utilities +!------------------------------------------------------------------------------- + +! Compare strings s1 and s2 while ignoring case +function string_equal_ci(s1, s2) result(is_equal) + character(*), intent(in) :: s1, s2 + logical :: is_equal + integer(IntKi), parameter :: ca = iachar("a") + integer(IntKi), parameter :: cz = iachar("z") + integer(IntKi) :: i, j + integer(IntKi) :: c1, c2 + is_equal = .false. + i = len_trim(s1) + j = len_trim(s2) + if (i /= j) return + do i = 1, j + c1 = iachar(s1(i:i)) + c2 = iachar(s2(i:i)) + if (c1 == c2) cycle + if (c1 >= ca .and. c1 <= cz) c1 = c1 - 32 + if (c2 >= ca .and. c2 <= cz) c2 = c2 - 32 + if (c1 /= c2) return + end do + is_equal = .true. +end function + +!------------------------------------------------------------------------------- +! Rotation Utilities +!------------------------------------------------------------------------------- + +pure function dcm_to_quat(R) result(q) + real(R8Ki), intent(in) :: R(3, 3) + real(R8Ki) :: q(4), C + integer(IntKi) :: j + + q = [(1.0_R8Ki + R(1, 1) - R(2, 2) - R(3, 3)), & + (1.0_R8Ki - R(1, 1) + R(2, 2) - R(3, 3)), & + (1.0_R8Ki - R(1, 1) - R(2, 2) + R(3, 3)), & + (1.0_R8Ki + R(1, 1) + R(2, 2) + R(3, 3))] + + ! Get index of max value in q + j = maxloc(q, dim=1) + + ! Calculate quaternion from direction cosine matrix + C = q(j) + select case (j) + case (1) + q = [C, (R(1, 2) + R(2, 1)), (R(3, 1) + R(1, 3)), (R(2, 3) - R(3, 2))] + case (2) + q = [(R(1, 2) + R(2, 1)), C, (R(2, 3) + R(3, 2)), (R(3, 1) - R(1, 3))] + case (3) + q = [(R(3, 1) + R(1, 3)), (R(2, 3) + R(3, 2)), C, (R(1, 2) - R(2, 1))] + case (4) + q = [(R(2, 3) - R(3, 2)), (R(3, 1) - R(1, 3)), (R(1, 2) - R(2, 1)), C] + end select + q = q/(2.0_R8Ki*sqrt(C)) +end function + +pure function quat_to_dcm(q) result(R) + real(R8Ki), intent(in) :: q(4) + real(R8Ki) :: R(3, 3) + real(R8Ki) :: q1, q2, q3, q4 + q1 = q(1); q2 = q(2); q3 = q(3); q4 = q(4) + R(1, :) = [q4*q4 + q1*q1 - q2*q2 - q3*q3, 2*(q1*q2 + q3*q4), 2*(q1*q3 - q2*q4)] + R(2, :) = [2*(q1*q2 - q3*q4), q4*q4 - q1*q1 + q2*q2 - q3*q3, 2*(q2*q3 + q1*q4)] + R(3, :) = [2*(q1*q3 + q2*q4), 2*(q2*q3 - q1*q4), q4*q4 - q1*q1 - q2*q2 + q3*q3] +end function + +pure function wm_to_quat(c) result(q) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: q(4) + real(R8Ki) :: c0, e0, e(3) + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + e0 = c0/(4.0_R8Ki - c0) + e = c/(4.0_R8Ki - c0) + q = [e, e0] +end function + +pure function wm_from_quat(q) result(c) + real(R8Ki), intent(in) :: q(4) + real(R8Ki) :: c(3) + real(R8Ki) :: e0, e(3) + e0 = q(4) + e = q(1:3) + c = 4.0_R8Ki*e/(1.0_R8Ki + e0) +end function + +pure function wm_to_dcm(c) result(R) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: R(3, 3) + R = quat_to_dcm(wm_to_quat(c)) +end function + +pure function wm_from_dcm(R) result(c) + real(R8Ki), intent(in) :: R(3, 3) + real(R8Ki) :: c(3) + c = wm_from_quat(dcm_to_quat(R)) +end function + +pure function wm_compose(p, q) result(r) + real(R8Ki), intent(in) :: p(3), q(3) + real(R8Ki) :: r(3) + real(R8Ki) :: p0, q0, D1, D2 + p0 = 2.0_R8Ki - dot_product(p, p)/8.0_R8Ki + q0 = 2.0_R8Ki - dot_product(q, q)/8.0_R8Ki + D1 = (4.0_R8Ki - p0)*(4.0_R8Ki - q0) + D2 = p0*q0 - dot_product(p, q) + if (D2 >= 0.0_R8Ki) then + r = 4*(q0*p + p0*q + cross(p, q))/(D1 + D2) + else + r = -4*(q0*p + p0*q + cross(p, q))/(D1 - D2) + end if +end function + +pure function wm_to_zyx(c) result(zyx) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: zyx(3) + real(R8Ki) :: q(4), qx, qy, qz, qw + q = wm_to_quat(c) + qx = q(1); qy = q(2); qz = q(3); qw = q(4) + zyx(1) = atan2(2*(qw*qx + qy*qz), 1.0_R8Ki - 2.0_R8Ki*(qx*qx + qy*qy)) + zyx(2) = -PiBy2_D + 2.0_R8Ki*atan2(sqrt(1.0_R8Ki + 2.0_R8Ki*(qw*qy - qx*qz)), & + sqrt(1.0_R8Ki - 2.0_R8Ki*(qw*qy - qx*qz))) + zyx(3) = atan2(2.0_R8Ki*(qw*qz + qx*qy), 1.0_R8Ki - 2.0_R8Ki*(qy*qy + qz*qz)) +end function + +pure function wm_inv(c) result(cinv) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: cinv(3) + cinv = -c +end function + +pure function cross(a, b) result(c) + real(R8Ki), intent(in) :: a(3), b(3) + real(R8Ki) :: c(3) + c = [a(2)*b(3) - a(3)*b(2), & + -a(3)*b(1) + a(1)*b(3), & + a(1)*b(2) - a(2)*b(1)] +end function + +end module diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index 9772468d1b..501580fd91 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -75,6 +75,7 @@ MODULE NWTC_Library USE NWTC_Num ! technically we don't need to specify this if we have ModMesh (because ModMesh USEs NWTC_Num) USE ModMesh USE ModReg + USE ModVar #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines From 49de27af70429311930cd8d94a70c59faaa5df9a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:37:10 +0000 Subject: [PATCH 04/61] Modify ElastoDyn for tight coupling These changes add vars and vals to ED so the module can be used in the tight coupling solver. --- modules/elastodyn/src/ElastoDyn.f90 | 1462 +++++++----------- modules/elastodyn/src/ElastoDyn_Registry.txt | 10 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 277 ++-- 3 files changed, 748 insertions(+), 1001 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 2bcfb11fc4..56f07b3256 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -63,8 +63,115 @@ MODULE ElastoDyn ! states (z) PUBLIC :: ED_GetOP ! Routine to pack the operating point values (for linearization) into arrays + + PUBLIC :: ED_PackStateValues, ED_UnpackStateValues + PUBLIC :: ED_PackInputValues, ED_UnpackInputValues + PUBLIC :: ED_PackOutputValues CONTAINS + +subroutine ED_PackStateValues(p, x, arr) + type(ED_ParameterType), intent(in) :: p + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: arr(:) + integer(IntKi) :: i + arr = 0.0_R8Ki + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + arr(p%Vars%x(i)%iLoc) = x%QT(p%Vars%x(i)%iUsr) + case (VF_TransVel, VF_AngularVel) + arr(p%Vars%x(i)%iLoc) = x%QDT(p%Vars%x(i)%iUsr) + end select + end do +end subroutine + +subroutine ED_UnpackStateValues(p, arr, x) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: arr(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + x%QT(p%Vars%x(i)%iUsr) = arr(p%Vars%x(i)%iLoc) + case (VF_TransVel, VF_AngularVel) + x%QDT(p%Vars%x(i)%iUsr) = arr(p%Vars%x(i)%iLoc) + end select + end do +end subroutine + +subroutine ED_PackInputValues(p, u, arr) + type(ED_ParameterType), intent(in) :: p + type(ED_InputType), intent(in) :: u + real(R8Ki), intent(out) :: arr(:) + integer(IntKi) :: iv, i + arr = 0.0_R8Ki + iv = 1 + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_PackMesh(p%Vars%u(iv:iv+1), u%BladePtLoads(i), arr); iv = iv + 2 + end do + end if + call MV_PackMesh(p%Vars%u(iv:iv+1), u%PlatformPtMesh, arr); iv = iv + 2 + call MV_PackMesh(p%Vars%u(iv:iv+1), u%TowerPtLoads, arr); iv = iv + 2 + call MV_PackMesh(p%Vars%u(iv:iv+1), u%HubPtLoad, arr); iv = iv + 2 + call MV_PackMesh(p%Vars%u(iv:iv+1), u%NacelleLoads, arr); iv = iv + 2 + arr(p%Vars%u(iv)%iLoc) = pack(u%BlPitchCom,.true.); iv = iv + 1 + arr(p%Vars%u(iv)%iLoc) = u%YawMom; iv = iv + 1 + arr(p%Vars%u(iv)%iLoc) = u%GenTrq; iv = iv + 1 + arr(p%Vars%u(p%iBlPitchComCVar)%iLoc) = u%BlPitchCom(1) ! extended +end subroutine + +subroutine ED_UnpackInputValues(p, arr, u) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: arr(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: iv, i + iv = 1 + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%BladePtLoads(i)); iv = iv + 2 + end do + end if + call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%PlatformPtMesh); iv = iv + 2 + call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%TowerPtLoads); iv = iv + 2 + call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%HubPtLoad); iv = iv + 2 + call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%NacelleLoads); iv = iv + 2 + u%BlPitchCom = arr(p%Vars%u(iv)%iLoc); iv = iv + 1 + u%YawMom = arr(p%Vars%u(iv)%iLoc(1)); iv = iv + 1 + u%GenTrq = arr(p%Vars%u(iv)%iLoc(1)); iv = iv + 1 +end subroutine + +subroutine ED_PackOutputValues(p, y, arr) + type(ED_ParameterType), intent(in) :: p + type(ED_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: arr(:) + integer(IntKi) :: iv, i + arr = 0.0_R8Ki + iv = 1 + if (allocated(y%BladeLn2Mesh)) then + do i = 1, size(y%BladeLn2Mesh) + call MV_PackMesh(p%Vars%y(iv:iv+5), y%BladeLn2Mesh(i), arr); iv = iv + 6 + end do + end if + call MV_PackMesh(p%Vars%y(iv:iv+5), y%PlatformPtMesh, arr); iv = iv + 6 + call MV_PackMesh(p%Vars%y(iv:iv+5), y%TowerLn2Mesh, arr); iv = iv + 6 + call MV_PackMesh(p%Vars%y(iv:iv+2), y%HubPtMotion, arr); iv = iv + 3 + if (allocated(y%BladeRootMotion)) then + do i = 1, size(y%BladeRootMotion) + call MV_PackMesh(p%Vars%y(iv:iv+5), y%BladeRootMotion(i), arr); iv = iv + 6 + end do + end if + call MV_PackMesh(p%Vars%y(iv:iv+5), y%NacelleMotion, arr); iv = iv + 6 + arr(p%Vars%y(iv)%iLoc) = y%Yaw; iv = iv + 1 + arr(p%Vars%y(iv)%iLoc) = y%YawRate; iv = iv + 1 + arr(p%Vars%y(iv)%iLoc) = y%HSS_Spd; iv = iv + 1 + do while (iv <= size(p%Vars%y)) + arr(p%Vars%y(iv)%iLoc(1)) = y%WriteOutput(p%Vars%y(iv)%iUsr(1)); iv = iv + 1 + end do +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. @@ -95,12 +202,15 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Local variables - TYPE(ED_InputFile) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: i, K ! loop counters - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - REAL(R8Ki) :: TransMat(3,3) ! Initial rotation matrix at Platform Refz - + TYPE(ED_InputFile) :: InputFileData ! Data stored in the module's input file + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + INTEGER(IntKi) :: i, j, k ! loop counters + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + REAL(R8Ki) :: TransMat(3,3) ! Initial rotation matrix at Platform Refz + REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + INTEGER(IntKi) :: iv + INTEGER(IntKi), allocatable :: imv(:) + TYPE(ModVarType) :: Var ! Initialize variables for this routine @@ -286,11 +396,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! set up data needed for linearization analysis !............................................................................................ - if (InitInp%Linearize) then - call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - end if + ! if (InitInp%Linearize) then + ! call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call CheckError( ErrStat2, ErrMsg2 ) + ! if (ErrStat >= AbortErrLev) return + ! end if !............................................................................................ @@ -300,6 +410,292 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut Interval = p%DT + !............................................................................................ + ! Module Variables + !............................................................................................ + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars) + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Add continuous state variables (translation and rotation) + call MV_AddVar(p%Vars%x, 'PlatformSurge', VF_TransDisp, & + iUsr=[DOF_Sg], & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & + Active=InputFileData%PtfmSgDOF) + call MV_AddVar(p%Vars%x, 'PlatformSway', VF_TransDisp, & + iUsr=[DOF_Sw], & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & + Active=InputFileData%PtfmSwDOF) + call MV_AddVar(p%Vars%x, 'PlatformHeave', VF_TransDisp, & + iUsr=[DOF_Hv], & + Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & + LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & + Active=InputFileData%PtfmHvDOF) + call MV_AddVar(p%Vars%x, 'PlatformRoll', VF_AngularDisp, & + iUsr=[DOF_R], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & + Active=InputFileData%PtfmRDOF) + call MV_AddVar(p%Vars%x, 'PlatformPitch', VF_AngularDisp, & + iUsr=[DOF_P], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & + Active=InputFileData%PtfmPDOF) + call MV_AddVar(p%Vars%x, 'PlatformYaw', VF_AngularDisp, & + iUsr=[DOF_Y], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & + Active=InputFileData%PtfmYDOF) + call MV_AddVar(p%Vars%x, 'TowerFA1', VF_TransDisp, & + iUsr=[DOF_TFA1], & + Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & + Active=InputFileData%TwFADOF1) + call MV_AddVar(p%Vars%x, 'TowerSS1', VF_TransDisp, & + iUsr=[DOF_TSS1], & + Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & + Active=InputFileData%TwSSDOF1) + call MV_AddVar(p%Vars%x, 'TowerFA2', VF_TransDisp, & + iUsr=[DOF_TFA2], & + Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & + Active=InputFileData%TwFADOF2) + call MV_AddVar(p%Vars%x, 'TowerSS2', VF_TransDisp, & + iUsr=[DOF_TSS2], & + Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & + LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & + Active=InputFileData%TwSSDOF2) + call MV_AddVar(p%Vars%x, 'NacelleYaw', VF_AngularDisp, & + iUsr=[DOF_Yaw], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & + Active=InputFileData%YawDOF) + call MV_AddVar(p%Vars%x, 'RotorFurl', VF_AngularDisp, & + iUsr=[DOF_RFrl], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & + Active=InputFileData%RFrlDOF) + call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', VF_AngularDisp, & + iUsr=[DOF_GeAz], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & + Active=InputFileData%GenDOF) + call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', VF_AngularDisp, & + iUsr=[DOF_DrTr], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & + Active=InputFileData%DrTrDOF) + call MV_AddVar(p%Vars%x, 'TailFurl', VF_AngularDisp, & + iUsr=[DOF_TFrl], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & + Active=InputFileData%TFrlDOF) + call MV_AddVar(p%Vars%x, 'RotorTeeter', VF_AngularDisp, & + iUsr=[DOF_Teet], & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & + Active=InputFileData%TeetDOF) + do i = 1, p%NumBl + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', VF_TransDisp, Flags=VF_RotFrame, & + iUsr=[DOF_BF(i,1)], & + Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['1st flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',1)), m'], & + Active=InputFileData%FlapDOF1) + end do + do i = 1, p%NumBl + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', VF_TransDisp, Flags=VF_RotFrame, & + iUsr=[DOF_BE(i,1)], & + Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['1st edgewise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BE('//trim(Num2LStr(i))//',1)), m'], & + Active=InputFileData%EdgeDOF) + end do + do i = 1, p%NumBl + call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', VF_TransDisp, Flags=VF_RotFrame, & + iUsr=[DOF_BF(i,2)], & + Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & + LinNames=['2nd flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& + ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',2)), m'], & + Active=InputFileData%FlapDOF2) + end do + + ! Derivatives of continuous state variables + do i = 1, size(p%Vars%x) + + ! Increase variable perturbation if below minimum + p%Vars%x(i)%Perturb = max(p%Vars%x(i)%Perturb, MinPerturb) + + ! Make a copy of variable + Var = p%Vars%x(i) + + ! Update linearization name + Var%LinNames(1) = 'First time derivative of '//trim(Var%LinNames(1))//'/s' + + ! Update from position to velocity + if (Var%Field == VF_TransDisp) Var%Field = VF_TransVel + if (Var%Field == VF_AngularDisp) Var%Field = VF_AngularVel + + ! Add variable (only active variables are in x) + call MV_AddVar(p%Vars%x, Var%Name, Var%Field, Flags=Var%Flags, & + iUsr=Var%iUsr, Perturb=Var%Perturb, LinNames=Var%LinNames) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Calculate values used for input perturbations + ! p%TipRad is set to 0 for BeamDyn simulations, so we're using a copy of the value from the input file here + ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) + MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 + MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 + + ! Blade Point Loads + if (allocated(u%BladePtLoads)) then + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%u, "Blade "//trim(Num2LStr(i)), LoadFields, & + Nodes=p%BldNodes, & + Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & + MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) + end do + end if + + ! Platform point loads + call MV_AddMeshVar(p%Vars%u, "Platform", LoadFields, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Tower point loads + call MV_AddMeshVar(p%Vars%u, "Tower", LoadFields, & + Nodes=p%TwrNodes, & + Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & + MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) + ! Hub point loads + call MV_AddMeshVar(p%Vars%u, "Hub", LoadFields, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Nacelle point loads + call MV_AddMeshVar(p%Vars%u, "Nacelle", LoadFields, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Non-mesh input variables + call MV_AddVar(p%Vars%u, "BlPitchCom", VF_Scalar, Flags=VF_RotFrame, & + Num=p%NumBl, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=[('Blade '//trim(num2lstr(i))//' pitch command, rad', i=1,p%NumBl)]) + p%iBlPitchCoModVarType = size(p%Vars%u) + call MV_AddVar(p%Vars%u, "YawMom", VF_Scalar, & + Perturb=MaxTorque / 100.0_R8Ki, & + LinNames=['Yaw moment, Nm']) + call MV_AddVar(p%Vars%u, "GenTrq", VF_Scalar, & + Perturb=MaxTorque / (100.0_R8Ki*p%GBRatio), & + LinNames=['Generator torque, Nm']) + call MV_AddVar(p%Vars%u, "BlPitchComC", VF_Scalar, Flags=VF_Ext, & + LinNames=['Extended input: collective blade-pitch command, rad']) + p%iBlPitchComCVar = size(p%Vars%u) + ! call MV_AddVar(p%Vars%u, "TwrAddedMass", VF_Scalar, Num=6*6*p%TwrNodes, Flags=VF_NoLin) + ! call MV_AddVar(p%Vars%u, "PtfmAddedMass", VF_Scalar, Num=6*6, Flags=VF_NoLin) + ! call MV_AddVar(p%Vars%u, "HSSBrTrqC", VF_Scalar, Num=1, Flags=VF_NoLin) + + ! Set minimum input perturbations + do i = 1,size(p%Vars%u) + p%Vars%u(i)%Perturb = max(p%Vars%u(i)%Perturb, MinPerturb) + end do + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), MotionFields, Nodes=p%BldNodes+2, Flags=VF_Line) + end do + call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields) + call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, Nodes=p%TwrNodes+2, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'Hub', [VF_TransDisp, VF_Orientation, VF_AngularVel]) + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields) + end do + call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields) + call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, LinNames=['Yaw, rad']) + call MV_AddVar(p%Vars%y, 'YawRate', VF_Scalar, LinNames=['YawRate, rad/s']) + call MV_AddVar(p%Vars%y, 'HSS_Spd', VF_Scalar, LinNames=['HSS_Spd, rad/s']) + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + Flags=OutParamFlags(p%OutParam(i)%Indx), & + iUsr=[i], & + LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & + Active=p%OutParam(i)%Indx > 0) + end do + do i = 1, p%BldNd_TotNumOuts + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & + Flags=VF_RotFrame, & + iUsr=[p%NumOuts+i], & + LinNames=[trim(p%BldNd_OutParam(i)%Name)//', '//trim(p%BldNd_OutParam(i)%Units)], & + Active=p%BldNd_OutParam(i)%Indx > 0) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVars(p%Vars, m%Vals, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2, ErrMsg2) + IF (ErrStat >= AbortErrLev) RETURN + + if (InitInp%Linearize) then + ! State Variables + CALL AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) + CALL AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) + CALL AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) + if (ErrStat >= AbortErrLev) return + InitOut%DerivOrder_x = 2 + do i = 1, size(p%Vars%x) + do j = 1, p%Vars%x(i)%NumLin + InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames + InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 + end do + end do + + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); call CheckError(ErrStat2, ErrMsg2) + call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); call CheckError(ErrStat2, ErrMsg2) + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); call CheckError(ErrStat2, ErrMsg2) + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%NumLin + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + CALL AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) + CALL AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%NumLin + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 + end do + end do + end if + + ! Associate pointers in initialization output + InitOut%Vars => p%Vars + InitOut%Vals => m%Vals + + !............................................................................................ + ! Summary and cleanup + !............................................................................................ ! Print the summary file if requested: IF (InputFileData%SumPrint) THEN @@ -351,6 +747,25 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError + function OutParamFlags(indx) result(flags) + integer(IntKi), intent(in) :: indx + integer(IntKi) :: flags + integer(IntKi), parameter :: RotatingFrameIndices(*) = [& + TipDxc, TipDyc, TipDzc, TipDxb, TipDyb, & + TipALxb, TipALyb, TipALzb, TipRDxb, TipRDyb, TipRDzc, TipClrnc, & + PtchPMzc, & + RootFxc, RootFyc, RootFzc, RootFxb, RootFyb, & + RootMxc, RootMyc, RootMzc, RootMxb, RootMyb, & + SpnALxb, SpnALyb, SpnALzb, SpnFLxb, SpnFLyb, SpnFLzb, & + SpnMLxb, SpnMLyb, SpnMLzb, SpnTDxb, SpnTDyb, SpnTDzb, & + SpnRDxb, SpnRDyb, SpnRDzb] + if (any(RotatingFrameIndices == indx)) then + flags = VF_RotFrame + else + flags = VF_None + end if + end function + END SUBROUTINE ED_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. @@ -482,7 +897,7 @@ END SUBROUTINE ED_UpdateStates !! NOTE: no matter how many channels are selected for output, all of the outputs are calculated !! All of the calculated output channels are placed into the m\%AllOuts(:), while the channels selected for outputs are !! placed in the y\%WriteOutput(:) array. -SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, yarr ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -497,6 +912,7 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), OPTIONAL, INTENT(INOUT) :: yarr(:) !< Optional array for packing output ! Local variables: @@ -1853,13 +2269,16 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%LSShftFzs = m%AllOuts(LSShftFzs)*1000. ! Nonrotating low-speed shaft force z (GL co-ords) (N) - RETURN + ! If output array is present, pack output data + if (present(yarr)) then + call ED_PackOutputValues(p, y, yarr) + end if END SUBROUTINE ED_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states. -SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) +SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg, dxdtarr ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -1873,6 +2292,7 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta TYPE(ED_ContinuousStateType), INTENT(INOUT) :: dxdt !< Continuous state derivatives at t [intent in so we don't need to allocate/deallocate constantly] INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), OPTIONAL, INTENT(INOUT) :: dxdtarr(:) !< Array for packing the continuous state derivatives ! LOCAL variables LOGICAL, PARAMETER :: UpdateValues = .TRUE. ! determines if the OtherState values need to be updated @@ -1978,6 +2398,11 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ! need m%QD2T set before calling this !OtherState%SgnPrvLSTQ = SignLSSTrq(p, m) + + ! If derivative array is present, pack derivative data + if (present(dxdtarr)) then + call ED_PackStateValues(p, dxdt, dxdtarr) + end if END SUBROUTINE ED_CalcContStateDeriv @@ -10196,15 +10621,11 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] - ! local variables TYPE(ED_OutputType) :: y_p - TYPE(ED_OutputType) :: y_m TYPE(ED_ContinuousStateType) :: x_p - TYPE(ED_ContinuousStateType) :: x_m TYPE(ED_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j + INTEGER(IntKi) :: i, j, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10224,16 +10645,17 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call cleanup() return end if - - + ! Pack operating point input values for perturbations + call ED_PackInputValues(p, u, m%Vals%u) + IF ( PRESENT( dYdu ) ) THEN ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+1, 'dYdu', ErrStat2, ErrMsg2) + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10244,54 +10666,45 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! make a copy of outputs because we will need two for the central difference computations (with orientations) call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() return end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute y at u_op - delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - - end do - - ! now do the extended input: sum the p%NumBl blade pitch columns - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)+1) + dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) + + ! Loop through input variables + do i = 1,size(p%Vars%u) + + ! If variable is not for linearization or is extended, skip + if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%NumLin + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdu(:,k)) + end do end do - - + + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + dYdu(:,p%Vars%u(p%iBlPitchComCVar)%iLoc(1)) = sum(dYdu(:,p%Vars%u(p%iBlPitchCoModVarType)%iLoc), dim=2) + if (ErrStat>=AbortErrLev) then call cleanup() return end if call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF @@ -10302,7 +10715,7 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%DOFs%NActvDOF * 2, size(p%Jac_u_indx,1)+1, 'dXdu', ErrStat2, ErrMsg2) + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10310,64 +10723,38 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end if end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute x at u_op + delta u - call ED_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call ED_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute x at u_op - delta u - call ED_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdu(j, i) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) + ! Loop through input variables + do i = 1,size(p%Vars%u) + + ! If extended linearization variable, skip + if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%NumLin + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call ED_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xp) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call ED_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xn) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%x, p%Vars%u(i)%Perturb, m%Vals%xp, m%Vals%xn, dXdu(:,k)) end do - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdu(j+p%DOFs%NActvDOF, i) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) - end do - dXdu(:,i) = dXdu(:,i) / (2*delta) - - end do - - - ! now do the extended input: sum the p%NumBl blade pitch columns - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)+1) + dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) end do - + + ! Extended: BlPitchComC is the sum of BlPitchCom across all blades + dXdu(:,p%Vars%u(p%iBlPitchComCVar)%iLoc(1)) = sum(dXdu(:,p%Vars%u(p%iBlPitchCoModVarType)%iLoc), dim=2) call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - - IF ( PRESENT( dXddu ) ) THEN if (allocated(dXddu)) deallocate(dXddu) @@ -10381,11 +10768,9 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM contains subroutine cleanup() + call ED_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call ED_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup @@ -10421,12 +10806,9 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! local variables TYPE(ED_OutputType) :: y_p - TYPE(ED_OutputType) :: y_m TYPE(ED_ContinuousStateType) :: x_p - TYPE(ED_ContinuousStateType) :: x_m TYPE(ED_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j + INTEGER(IntKi) :: i, j, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10439,6 +10821,9 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg = '' m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function + ! Pack operating point state values for perturbations + call ED_PackStateValues(p, x, m%Vals%x) + ! make a copy of the continuous states to perturb call ED_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -10453,7 +10838,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%DOFs%NActvDOF*2, 'dYdx', ErrStat2, ErrMsg2) + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10461,42 +10846,38 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) + ! make a copy of outputs for the central difference computations (with orientations) call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() return end if - - do i=1,p%DOFs%NActvDOF*2 - - ! get x_op + delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_x( p, i, 1, x_perturb, delta ) - - ! compute y at x_op + delta x - call ED_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get x_op - delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call ED_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) - + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If variable is not for linearization or is extended, skip + if (iand(p%Vars%x(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%NumLin + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdx(:,k)) + end do end do if (ErrStat>=AbortErrLev) then @@ -10504,7 +10885,6 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, return end if call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more END IF @@ -10514,56 +10894,41 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dXdx if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%DOFs%NActvDOF * 2, p%DOFs%NActvDOF * 2, 'dXdx', ErrStat2, ErrMsg2) + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() return end if end if - - do i=1,p%DOFs%NActvDOF * 2 - - ! get x_op + delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_Perturb_x( p, i, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call ED_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get x_op - delta x - call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute x at x_op - delta x - call ED_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdx(j, i) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If no-lin or extended linearization variable, skip + if (iand(p%Vars%x(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%NumLin + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call ED_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xp) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call ED_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xn) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%x, p%Vars%x(i)%Perturb, m%Vals%xp, m%Vals%xn, dXdx(:,k)) end do - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdx(j+p%DOFs%NActvDOF, i) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) - end do - dXdx(:,i) = dXdx(:,i) / (2*delta) - end do - + call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more END IF IF ( PRESENT( dXddx ) ) THEN @@ -10579,9 +10944,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, contains subroutine cleanup() call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call ED_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup @@ -10732,608 +11095,6 @@ SUBROUTINE ED_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE ED_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. -SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables: - INTEGER(IntKi) :: i,j,k, index_last, index_next - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_y' - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - logical, allocatable :: AllOut(:) - - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = 0 - if (allocated(y%BladeLn2Mesh)) then - do i=1,p%NumBl - p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node on each blade - end do - end if - - p%Jac_ny = p%Jac_ny & - + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, and RotationVel at each node - + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + 3 & ! Yaw, YawRate, and HSS_Spd - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - - do i=1,p%NumBl - p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade - end do - - - !................. - ! set linearization output names: - !................. - CALL AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%RotFrame_y = .false. ! note that meshes are in the global, not rotating frame - - ! note that this Mask is for the y%HubPtMotion mesh ONLY. The others pack *all* of the motion fields - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - index_next = 1 - if (allocated(y%BladeLn2Mesh)) then - index_last = index_next - do i=1,p%NumBl - call PackMotionMesh_Names(y%BladeLn2Mesh(i), 'Blade '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) - end do - !InitOut%RotFrame_y(index_last:index_next-1) = .true. ! values on the mesh are in global, not rotating frame - end if - call PackMotionMesh_Names(y%PlatformPtMesh, 'Platform', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%TowerLn2Mesh, 'Tower', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%HubPtMotion, 'Hub', InitOut%LinNames_y, index_next, FieldMask=Mask) - index_last = index_next - do i=1,p%NumBl - call PackMotionMesh_Names(y%BladeRootMotion(i), 'Blade root '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) - end do - !InitOut%RotFrame_y(index_last:index_next-1) = .true. ! values on the mesh are in global, not rotating frame - - call PackMotionMesh_Names(y%NacelleMotion, 'Nacelle', InitOut%LinNames_y, index_next) - InitOut%LinNames_y(index_next) = 'Yaw, rad'; index_next = index_next+1 - InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 - InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+index_next) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - - !! check for AllOuts in rotating frame - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if - - AllOut = .false. - do k=1,3 - AllOut(TipDxc( k)) = .true. - AllOut(TipDyc( k)) = .true. - AllOut(TipDzc( k)) = .true. - AllOut(TipDxb( k)) = .true. - AllOut(TipDyb( k)) = .true. - AllOut(TipALxb( k)) = .true. - AllOut(TipALyb( k)) = .true. - AllOut(TipALzb( k)) = .true. - AllOut(TipRDxb( k)) = .true. - AllOut(TipRDyb( k)) = .true. - AllOut(TipRDzc( k)) = .true. - AllOut(TipClrnc(k)) = .true. - AllOut(PtchPMzc(k)) = .true. - AllOut(RootFxc( k)) = .true. - AllOut(RootFyc( k)) = .true. - AllOut(RootFzc( k)) = .true. - AllOut(RootFxb( k)) = .true. - AllOut(RootFyb( k)) = .true. - AllOut(RootMxc( k)) = .true. - AllOut(RootMyc( k)) = .true. - AllOut(RootMzc( k)) = .true. - AllOut(RootMxb( k)) = .true. - AllOut(RootMyb( k)) = .true. - - do j=1,9 - AllOut(SpnALxb( j,k)) = .true. - AllOut(SpnALyb( j,k)) = .true. - AllOut(SpnALzb( j,k)) = .true. - AllOut(SpnFLxb( j,k)) = .true. - AllOut(SpnFLyb( j,k)) = .true. - AllOut(SpnFLzb( j,k)) = .true. - AllOut(SpnMLxb( j,k)) = .true. - AllOut(SpnMLyb( j,k)) = .true. - AllOut(SpnMLzb( j,k)) = .true. - AllOut(SpnTDxb( j,k)) = .true. - AllOut(SpnTDyb( j,k)) = .true. - AllOut(SpnTDzb( j,k)) = .true. - AllOut(SpnRDxb( j,k)) = .true. - AllOut(SpnRDyb( j,k)) = .true. - AllOut(SpnRDzb( j,k)) = .true. - end do - end do - - do i=1,p%NumOuts - InitOut%RotFrame_y(i+index_next) = AllOut( p%OutParam(i)%Indx ) - end do - - do i=1, p%BldNd_TotNumOuts - InitOut%RotFrame_y(i+p%NumOuts+index_next) = .true. - end do - - deallocate(AllOut) - - -END SUBROUTINE ED_Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. -SUBROUTINE ED_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_x' - - ! local variables: - INTEGER(IntKi) :: i - - ErrStat = ErrID_None - ErrMsg = "" - - - ! allocate space for the row/column names and for perturbation sizes - call allocAry(p%dx, p%NDof, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%LinNames_x, p%DOFs%NActvDOF*2, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, p%DOFs%NActvDOF*2, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%DOFs%NActvDOF*2, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! All Elastodyn continuous states are max order = 2 - if ( allocated(InitOut%DerivOrder_x) ) InitOut%DerivOrder_x = 2 - - p%dx = 0.0_R8Ki ! initialize in case we have only 1 blade - - ! set perturbation sizes: p%dx - p%dx(DOF_Sg :DOF_Hv) = 0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi) ! platform translational displacement states - p%dx(DOF_R :DOF_Y ) = 2.0_R8Ki * D2R_D ! platform rotational states - p%dx(DOF_TFA1:DOF_TSS1) = 0.020_R8Ki * D2R_D * p%TwrFlexL ! tower deflection states: 1st tower - p%dx(DOF_TFA2:DOF_TSS2) = 0.002_R8Ki * D2R_D * p%TwrFlexL ! tower deflection states: 2nd tower - p%dx(DOF_Yaw :DOF_TFrl) = 2.0_R8Ki * D2R_D ! nacelle-yaw, rotor-furl, generator azimuth, drivetrain, and tail-furl rotational states - - do i=1,p%NumBl - p%dx(DOF_BF(i,1))= 0.20_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 1st blade flap mode - p%dx(DOF_BF(i,2))= 0.02_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 2nd blade flap mode for blades (1/10 of the other perturbations) - p%dx(DOF_BE(i,1))= 0.20_R8Ki * D2R_D * p%BldFlexL ! blade-deflection states: 1st blade edge mode - end do - - if ( p%NumBl == 2 ) then - p%dx(DOF_Teet) = 2.0_R8Ki * D2R_D ! rotor-teeter rotational state - end if - - !Set some limits in case perturbation is very small - do i=1,p%NDof - p%dx(i) = max(p%dx(i), MinPerturb) - end do - - InitOut%RotFrame_x = .false. - do i=1,p%DOFs%NActvDOF - if ( p%DOFs%PS(i) >= DOF_BF(1,1) ) then - if ( p%NumBl == 2 ) then - InitOut%RotFrame_x(i) = p%DOFs%PS(i) < DOF_Teet - else - InitOut%RotFrame_x(i) = .true. ! = p%DOFs%PS(i) <= DOF_BF (MaxBl,NumBF) - end if - end if - end do - - ! set linearization output names: - do i=1,p%DOFs%NActvDOF - InitOut%LinNames_x(i) = p%DOF_Desc( p%DOFs%PS(i) ) - end do - - do i=1,p%DOFs%NActvDOF - InitOut%LinNames_x(i+p%DOFs%NActvDOF) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%DOFs%NActvDOF) = InitOut%RotFrame_x(i) - end do - -END SUBROUTINE ED_Init_Jacobian_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing corresponding linearization routines ! -SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) - - TYPE(ED_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(ED_InputType) , INTENT(IN ) :: u !< inputs - TYPE(ED_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(ED_InitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField, m - REAL(R8Ki) :: MaxThrust, MaxTorque - REAL(R8Ki) :: ScaleLength - - - - ErrStat = ErrID_None - ErrMsg = "" - - - call ED_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call ED_Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - - ! determine how many inputs there are in the Jacobians - nu = 0; - if (allocated(u%BladePtLoads)) then - do i=1,p%NumBl - nu = nu + u%BladePtLoads(i)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade - end do - end if - nu = nu & - + u%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%HubPtLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%NacelleLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumBl & ! blade pitch command (BlPitchCom) - + 2 ! YawMom and GenTrq - - ! note: all other inputs are ignored - - !.................... - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see elastodyn::ed_perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index of the acceleration/load field - ! column 3 is the node - !.................... - - !............... - ! ED input mappings stored in p%Jac_u_indx: - !............... - call AllocAry(p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - index = 1 - if (allocated(u%BladePtLoads)) then - !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1; - !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2; - !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3; - !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4; - !Module/Mesh/Field: u%BladePtLoads(3)%Force = 5; - !Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6; - do k=1,p%NumBl - - do i_meshField = 1,2 - do i=1,u%BladePtLoads(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + (k-1)*2 !Module/Mesh/Field: u%BladePtLoads(k)%{Force/Moment} = m - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - end if - - !if MaxBl ever changes (i.e., MaxBl /=3), we need to modify this accordingly: - do i_meshField = 7,8 - do i=1,u%PlatformPtMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PlatformPtMesh%Force = 7; u%PlatformPtMesh%Moment = 8; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 9,10 - do i=1,u%TowerPtLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TowerPtLoads%Force = 9; u%TowerPtLoads%Moment = 10; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 11,12 - do i=1,u%HubPtLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%HubPtLoad%Force = 11; u%HubPtLoad%Moment = 12; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 13,14 - do i=1,u%NacelleLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%NacelleLoads%Force = 13; u%NacelleLoads%Moment = 14; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 1,p%NumBl ! scalars - p%Jac_u_indx(index,1) = 15 !Module/Mesh/Field: u%BlPitchCom = 15; - p%Jac_u_indx(index,2) = 1 !index: n/a - p%Jac_u_indx(index,3) = i_meshField !Node: blade - index = index + 1 - end do - - do i_meshField = 16,17 ! scalars - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 16; u%GenTrq = 17; - p%Jac_u_indx(index,2) = 1 !index: j - p%Jac_u_indx(index,3) = 1 !Node: i - index = index + 1 - end do - - !................ - ! input perturbations, du: - !................ - call AllocAry(p%du, 17, 'p%du', ErrStat2, ErrMsg2) ! 17 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! p%TipRad is set to 0 for BeamDyn simulations, so we're using a copy of the value from the input file here - ScaleLength = max(p%TipRad, p%TowerHt, 1.0_ReKi) - MaxThrust = 490.0_R8Ki * pi_D / 9.0_R8Ki * ScaleLength**2 - MaxTorque = 122.5_R8Ki * pi_D / 27.0_R8Ki * ScaleLength**3 - - if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl - p%du(2*k-1) = MaxThrust / real(100*p%NumBl*u%BladePtLoads(k)%NNodes,R8Ki) ! u%BladePtLoads(k)%Force = 2*k-1 - p%du(2*k ) = MaxTorque / real(100*p%NumBl*u%BladePtLoads(k)%NNodes,R8Ki) ! u%BladePtLoads(k)%Moment = 2*k - end do !k - else - p%du(1:6) = 0.0_R8Ki - end if - - p%du( 7) = MaxThrust / 100.0_R8Ki ! u%PlatformPtMesh%Force = 7 - p%du( 8) = MaxTorque / 100.0_R8Ki ! u%PlatformPtMesh%Moment = 8 - p%du( 9) = MaxThrust / real(100*u%TowerPtLoads%NNodes,R8Ki) ! u%TowerPtLoads%Force = 9 - p%du(10) = MaxTorque / real(100*u%TowerPtLoads%NNodes,R8Ki) ! u%TowerPtLoads%Moment = 10 - p%du(11) = MaxThrust / 100.0_R8Ki ! u%HubPtLoad%Force = 11 - p%du(12) = MaxTorque / 100.0_R8Ki ! u%HubPtLoad%Moment = 12 - p%du(13) = MaxThrust / 100.0_R8Ki ! u%NacelleLoads%Force = 13 - p%du(14) = MaxTorque / 100.0_R8Ki ! u%NacelleLoads%Moment = 14 - p%du(15) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 15 - p%du(16) = MaxTorque / 100.0_R8Ki ! u%YawMom = 16 - p%du(17) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 17 - - !Set some limits in case perturbation is very small - do i=1,size(p%du) - p%du(i) = max(p%du(i), MinPerturb) - end do - - !................ - ! names of the columns, InitOut%LinNames_u: - !................ - call AllocAry(InitOut%LinNames_u, nu+1, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu+1, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu+1, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%IsLoad_u = .true. ! most of ED's inputs are loads; we will override the non-load inputs below. - InitOut%RotFrame_u = .false. - index = 1 - if (allocated(u%BladePtLoads)) then - index_last = index - do k=1,p%NumBl - call PackLoadMesh_Names(u%BladePtLoads(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index) - end do - !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh are in global, not rotating frame - end if - call PackLoadMesh_Names(u%PlatformPtMesh, 'Platform', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%TowerPtLoads, 'Tower', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%HubPtLoad, 'Hub', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%NacelleLoads, 'Nacelle', InitOut%LinNames_u, index) - - do k = 1,p%NumBl ! scalars - InitOut%LinNames_u(index) = 'Blade '//trim(num2lstr(k))//' pitch command, rad' - InitOut%IsLoad_u( index) = .false. - InitOut%RotFrame_u(index) = .true. - index = index + 1 - end do - - InitOut%LinNames_u(index) = 'Yaw moment, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Generator torque, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Extended input: collective blade-pitch command, rad' - InitOut%IsLoad_u( index) = .false. - -END SUBROUTINE ED_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(ED_InputType) , INTENT(INOUT) :: u !< perturbed ED inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1 - u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 - u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 3) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 - u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 - u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 5 - u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 6 - u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%PlatformPtMesh%Force = 7 - u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 - u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 9) !Module/Mesh/Field: u%TowerPtLoads%Force = 9 - u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%TowerPtLoads%Moment = 10 - u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (11) !Module/Mesh/Field: u%HubPtLoad%Force = 11 - u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%HubPtLoad%Moment = 12 - u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign - - CASE (13) !Module/Mesh/Field: u%NacelleLoads%Force = 13 - u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%NacelleLoads%Moment = 14 - u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BlPitchCom = 15 - u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%YawMom = 16 - u%YawMom = u%YawMom + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%GenTrq = 17 - u%GenTrq = u%GenTrq + du * perturb_sign - - END SELECT - -END SUBROUTINE ED_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the continuous state array. -!! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_x( p, n, perturb_sign, x, dx ) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(ED_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - - ! local variables - integer(intKi) :: indx - - - if (n > p%DOFs%NActvDOF) then - indx = p%DOFs%PS(n-p%DOFs%NActvDOF) - dx = p%dx( indx ) - - x%QDT( indx ) = x%QDT( indx ) + dx * perturb_sign - else - indx = p%DOFs%PS(n) - dx = p%dx( indx ) - - x%QT( indx ) = x%QT( indx ) + dx * perturb_sign - end if - -END SUBROUTINE ED_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) - - TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(ED_OutputType) , INTENT(IN ) :: y_p !< ED outputs at \f$ u + \Delta u \f$ or \f$ x + \Delta x \f$ (p=plus) - TYPE(ED_OutputType) , INTENT(IN ) :: y_m !< ED outputs at \f$ u - \Delta u \f$ or \f$ x - \Delta x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta = \Delta u \f$ or \f$ delta = \Delta x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - - ! local variables: - INTEGER(IntKi) :: k ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - - indx_first = 1 - if (allocated(y_p%BladeLn2Mesh)) then - do k=1,p%NumBl - call PackMotionMesh_dY(y_p%BladeLn2Mesh(k), y_m%BladeLn2Mesh(k), dY, indx_first) - end do - end if - - call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.true.) - call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.true.) - call PackMotionMesh_dY(y_p%HubPtMotion, y_m%HubPtMotion, dY, indx_first, FieldMask=Mask) - do k=1,p%NumBl - call PackMotionMesh_dY(y_p%BladeRootMotion(k), y_m%BladeRootMotion(k), dY, indx_first) - end do - call PackMotionMesh_dY(y_p%NacelleMotion, y_m%NacelleMotion, dY, indx_first) - - dY(indx_first) = y_p%Yaw - y_m%Yaw; indx_first = indx_first + 1 - dY(indx_first) = y_p%YawRate - y_m%YawRate; indx_first = indx_first + 1 - dY(indx_first) = y_p%HSS_Spd - y_m%HSS_Spd; indx_first = indx_first + 1 - - !indx_last = indx_first + p%NumOuts - 1 - do k=1,p%NumOuts + p%BldNd_TotNumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - dY = dY / (2.0_R8Ki*delta) - -END SUBROUTINE Compute_dY !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) @@ -11349,12 +11110,12 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) @@ -11376,33 +11137,15 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, !.................................. IF ( PRESENT( u_op ) ) THEN + if (.not. allocated(u_op)) then - call AllocAry(u_op, size(p%Jac_u_indx,1)+1,'u_op',ErrStat2,ErrMsg2) ! +1 for extended input here + call AllocAry(u_op, p%Vars%Nu,'u_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if + + call ED_PackInputValues(p, u, u_op) - index = 1 - if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl - call PackLoadMesh(u%BladePtLoads(k), u_op, index) - end do - end if - call PackLoadMesh(u%PlatformPtMesh, u_op, index) - call PackLoadMesh(u%TowerPtLoads, u_op, index) - call PackLoadMesh(u%HubPtLoad, u_op, index) - call PackLoadMesh(u%NacelleLoads, u_op, index) - - do k = 1,p%NumBl ! scalars - u_op(index) = u%BlPitchCom(k) - index = index + 1 - end do - u_op(index) = u%YawMom ; index = index + 1 - u_op(index) = u%GenTrq ; index = index + 1 - - ! extended input: - u_op(index) = u%BlPitchCom(1) - do k = 2,p%NumBl if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & @@ -11415,63 +11158,14 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, !.................................. IF ( PRESENT( y_op ) ) THEN - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if if (.not. allocated(y_op)) then - ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - ny = p%Jac_ny + y%PlatformPtMesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%TowerLn2Mesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%HubPtMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%NacelleMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node - - if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl - ny = ny + y%BladeLn2Mesh(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 (at each node on each blade) - end do - end if - do k=1,p%NumBl - ny = ny + y%BladeRootMotion(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node on each blade - end do - - call AllocAry(y_op, ny,'y_op',ErrStat2,ErrMsg2) + call AllocAry(y_op, p%Vars%Ny,'y_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - index = 1 - if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, TrimOP=ReturnTrimOP) - end do - end if - call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - - do k=1,p%NumBl - call PackMotionMesh(y%BladeRootMotion(k), y_op, index, TrimOP=ReturnTrimOP) - end do - call PackMotionMesh(y%NacelleMotion, y_op, index, TrimOP=ReturnTrimOP) - - y_op(index) = y%Yaw ; index = index + 1 - y_op(index) = y%YawRate ; index = index + 1 - y_op(index) = y%HSS_Spd - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do + call ED_PackOutputValues(p, y, y_op) END IF @@ -11479,17 +11173,12 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( x_op ) ) THEN if (.not. allocated(x_op)) then - call AllocAry(x_op, p%DOFs%NActvDOF * 2,'x_op',ErrStat2,ErrMsg2) + call AllocAry(x_op, p%Vars%Nx,'x_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if - - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - x_op(i) = x%QT( p%DOFs%PS(i) ) - end do - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - x_op(i+p%DOFs%NActvDOF) = x%QDT( p%DOFs%PS(i) ) - end do + + call ED_PackStateValues(p, x, x_op) END IF @@ -11497,7 +11186,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( dx_op ) ) THEN if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%DOFs%NActvDOF * 2,'dx_op',ErrStat2,ErrMsg2) + call AllocAry(dx_op, p%Vars%Nx,'dx_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if @@ -11509,12 +11198,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, return end if - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dx_op(i) = dx%QT( p%DOFs%PS(i) ) - end do - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dx_op(i+p%DOFs%NActvDOF) = dx%QDT( p%DOFs%PS(i) ) - end do + call ED_PackStateValues(p, dx, dx_op) call ED_DestroyContState( dx, ErrStat2, ErrMsg2) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index d18ab670cd..2d74092f7d 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -55,6 +55,8 @@ typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 i typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" +typedef ^ InitOutputType ModValsType *Vals - - - "Module Values" # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -521,10 +523,12 @@ typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAP typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - +typedef ^ MiscVarType ModValsType &Vals - - "Values corresponding to module variables" # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - @@ -744,10 +748,8 @@ typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and unit #typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ ParameterType IntKi iBlPitchCoModVarType - - - "Index of blade pitch command variable" - +typedef ^ ParameterType IntKi iBlPitchComCVar - - - "Index of blade pitch command C variable" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 45e632f0a6..7fe76490e2 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -75,6 +75,8 @@ MODULE ElastoDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] + TYPE(ModValsType) , POINTER :: Vals => NULL() !< Module Values [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -530,10 +532,12 @@ MODULE ElastoDyn_Types 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 = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + TYPE(ModValsType) , POINTER :: Vals => NULL() END TYPE ED_MiscVarType ! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -748,10 +752,8 @@ MODULE ElastoDyn_Types 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 = 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 = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: iBlPitchCoModVarType = 0_IntKi !< Index of blade pitch command variable [-] + INTEGER(IntKi) :: iBlPitchComCVar = 0_IntKi !< Index of blade pitch command C variable [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -1066,6 +1068,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if + DstInitOutputData%Vars => SrcInitOutputData%Vars + DstInitOutputData%Vals => SrcInitOutputData%Vals end subroutine subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1118,12 +1122,15 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%IsLoad_u)) then deallocate(InitOutputData%IsLoad_u) end if + nullify(InitOutputData%Vars) + nullify(InitOutputData%Vals) end subroutine subroutine ED_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitOutput' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then @@ -1204,6 +1211,20 @@ subroutine ED_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if + call RegPack(Buf, associated(InData%Vals)) + if (associated(InData%Vals)) then + call RegPackPointer(Buf, c_loc(InData%Vals), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModValsType(Buf, InData%Vals) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1214,6 +1235,8 @@ subroutine ED_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) @@ -1424,6 +1447,46 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + if (associated(OutData%Vals)) deallocate(OutData%Vals) + 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%Vals) + else + allocate(OutData%Vals,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vals) + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals + end if + else + OutData%Vals => null() + end if end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -7550,6 +7613,18 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%QD2T = SrcMiscData%QD2T end if DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod + if (associated(SrcMiscData%Vals)) then + if (.not. associated(DstMiscData%Vals)) then + allocate(DstMiscData%Vals, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vals.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if end subroutine subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -7586,12 +7661,19 @@ subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%QD2T)) then deallocate(MiscData%QD2T) end if + if (associated(MiscData%Vals)) then + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(MiscData%Vals) + MiscData%Vals => null() + 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' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call ED_PackCoordSys(Buf, InData%CoordSys) call ED_PackRtHndSide(Buf, InData%RtHS) @@ -7631,6 +7713,13 @@ subroutine ED_PackMisc(Buf, Indata) call RegPack(Buf, InData%QD2T) end if call RegPack(Buf, InData%IgnoreMod) + call RegPack(Buf, associated(InData%Vals)) + if (associated(InData%Vals)) then + call RegPackPointer(Buf, c_loc(InData%Vals), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModValsType(Buf, InData%Vals) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7641,6 +7730,8 @@ subroutine ED_UnPackMisc(Buf, OutData) integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call ED_UnpackCoordSys(Buf, OutData%CoordSys) ! CoordSys call ED_UnpackRtHndSide(Buf, OutData%RtHS) ! RtHS @@ -7744,6 +7835,26 @@ subroutine ED_UnPackMisc(Buf, OutData) end if call RegUnpack(Buf, OutData%IgnoreMod) if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%Vals)) deallocate(OutData%Vals) + 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%Vals) + else + allocate(OutData%Vals,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vals) + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals + end if + else + OutData%Vals => null() + end if end subroutine subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -7759,6 +7870,18 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%DT = SrcParamData%DT DstParamData%DT24 = SrcParamData%DT24 DstParamData%BldNodes = SrcParamData%BldNodes @@ -8588,43 +8711,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do 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 - 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 - 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 - end if - DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%iBlPitchCoModVarType = SrcParamData%iBlPitchCoModVarType + DstParamData%iBlPitchComCVar = SrcParamData%iBlPitchComCVar end subroutine subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -8638,6 +8726,12 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%PH)) then deallocate(ParamData%PH) end if @@ -8817,15 +8911,6 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) 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) @@ -8834,7 +8919,15 @@ subroutine ED_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackParam' integer(IntKi) :: i1, i2, i3, i4, i5 integer(IntKi) :: LB(5), UB(5) + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, InData%DT) call RegPack(Buf, InData%DT24) call RegPack(Buf, InData%BldNodes) @@ -9277,22 +9370,8 @@ subroutine ED_PackParam(Buf, Indata) end do end if call RegPack(Buf, InData%BldNd_BladesOut) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, allocated(InData%dx)) - if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) - call RegPack(Buf, InData%dx) - end if - call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%iBlPitchCoModVarType) + call RegPack(Buf, InData%iBlPitchComCVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -9304,7 +9383,29 @@ subroutine ED_UnPackParam(Buf, OutData) integer(IntKi) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DT24) @@ -10394,49 +10495,9 @@ subroutine ED_UnPackParam(Buf, OutData) end if call RegUnpack(Buf, OutData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%iBlPitchCoModVarType) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_ny) + call RegUnpack(Buf, OutData%iBlPitchComCVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine From f22c46b35fb79a11dee91d8a52cc80462da86b13 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:38:33 +0000 Subject: [PATCH 05/61] Add TIGHT_COUPLING CMake config option Using -DTIGHT_COUPLING=ON when configuring the project will make it build with the tight coupling solver --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5b14d3dd8d..510c31c977 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -39,6 +39,7 @@ option(VARIABLE_TRACKING "Enables variable tracking for better runtime debugging option(GENERATE_TYPES "Use the openfast-regsitry to autogenerate types modules" off) option(BUILD_SHARED_LIBS "Enable building shared libraries" off) option(DOUBLE_PRECISION "Treat REAL as double precision" on) +option(TIGHT_COUPLING "Enable tight couping solver" on) option(USE_DLL_INTERFACE "Enable runtime loading of dynamic libraries" on) option(FPE_TRAP_ENABLED "Enable FPE trap in compiler options" off) option(ORCA_DLL_LOAD "Enable OrcaFlex Library Load" on) From 8a076101c2a12d033e6cfcf4547f51b4acc77c9d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:41:55 +0000 Subject: [PATCH 06/61] Add tight coupling modules in OF-library These will need to renamed/merged --- .../nwtc-library/src/NWTC_Library_Types.f90 | 12 +- modules/openfast-library/CMakeLists.txt | 19 +- modules/openfast-library/src/FAST_Eval.f90 | 799 ++ modules/openfast-library/src/FAST_Lin_TC.f90 | 6964 +++++++++++++++ .../openfast-library/src/FAST_Registry.txt | 66 + modules/openfast-library/src/FAST_Subs_TC.f90 | 7923 +++++++++++++++++ modules/openfast-library/src/FAST_Types.f90 | 1726 +++- modules/openfast-library/src/Solver.f90 | 1233 +++ 8 files changed, 18676 insertions(+), 66 deletions(-) create mode 100644 modules/openfast-library/src/FAST_Eval.f90 create mode 100644 modules/openfast-library/src/FAST_Lin_TC.f90 create mode 100644 modules/openfast-library/src/FAST_Subs_TC.f90 create mode 100644 modules/openfast-library/src/Solver.f90 diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 254d9b6f50..ec261884ec 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -1063,7 +1063,7 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (.not. allocated(DstModVarsTypeData%ixg)) then allocate(DstModVarsTypeData%ixg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%ix.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%ixg.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -1075,7 +1075,7 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (.not. allocated(DstModVarsTypeData%iug)) then allocate(DstModVarsTypeData%iug(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iu.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iug.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -1087,7 +1087,7 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, if (.not. allocated(DstModVarsTypeData%iyg)) then allocate(DstModVarsTypeData%iyg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iy.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iyg.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -1293,7 +1293,7 @@ subroutine NWTC_Library_UnPackModVarsType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return allocate(OutData%ixg(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ixg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if call RegUnpack(Buf, OutData%ixg) @@ -1307,7 +1307,7 @@ subroutine NWTC_Library_UnPackModVarsType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return allocate(OutData%iug(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iug.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if call RegUnpack(Buf, OutData%iug) @@ -1321,7 +1321,7 @@ subroutine NWTC_Library_UnPackModVarsType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return allocate(OutData%iyg(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if call RegUnpack(Buf, OutData%iyg) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index d6d973f5e1..ef681f1d9c 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -61,12 +61,27 @@ target_link_libraries(openfast_prelib subdynlib ) -add_library(openfast_postlib - src/FAST_Lin.f90 +set(POSTLIB_SOURCES src/FAST_Mods.f90 src/FAST_Subs.f90 src/FAST_Solver.f90 ) + +if (TIGHT_COUPLING) + list(APPEND POSTLIB_SOURCES + src/FAST_Lin_TC.f90 + src/FAST_Subs_TC.f90 + src/FAST_Eval.f90 + src/Solver.f90 + ) +else() + list(APPEND POSTLIB_SOURCES + src/FAST_Lin.f90 + src/FAST_Subs.f90 + ) +endif() + +add_library(openfast_postlib ${POSTLIB_SOURCES}) target_link_libraries(openfast_postlib openfast_prelib foamfastlib scfastlib) target_include_directories(openfast_postlib PUBLIC $ diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 new file mode 100644 index 0000000000..3f7e188643 --- /dev/null +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -0,0 +1,799 @@ +module FAST_Eval + +use FAST_Solver +use FAST_ModTypes +use NWTC_LAPACK +use ElastoDyn +use BeamDyn +use SubDyn +use AeroDyn +use AeroDyn14 +use ServoDyn + +implicit none + +! Evaluate Module Flags +integer(IntKi), parameter :: EM_InitIO = 1, & + EM_ExtrapInterp = 2, & + EM_InputSolve = 4, & + EM_UpdateStates = 8, & + EM_CalcOutput = 16, & + EM_CalcContStateDeriv = 32, & + EM_JacobianPInput = 64, & + EM_JacobianPContState = 128, & + EM_SavePredStates = 256 + +contains + +subroutine FAST_EvalModules(t_initial, n_t_global, ModOrder, Mods, this_state, EvalFlags, T, ErrStat, ErrMsg, & + x, dxdt, dYdx, dXdx, dYdu, dXdu) + + real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) + integer(IntKi), intent(in) :: n_t_global !< Integer time step + integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate + type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules + integer(IntKi), intent(in) :: this_state !< State index + integer(IntKi), intent(in) :: EvalFlags !< Evaluation flags to control what to evaluate + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), optional, intent(in) :: x(:) + real(R8Ki), optional, intent(out) :: dxdt(:) + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) + + character(*), parameter :: RoutineName = 'EvaluateModules' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, iMod, iIns + real(DbKi) :: t_module ! Current simulation time for module + real(DbKi) :: t_global ! Simulation time for computing outputs + real(DbKi) :: t_global_next ! Simulation time for computing outputs + real(DbKi) :: this_time ! Time for calculating outputs (based on this_state) + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate global time and next global time + t_global = n_t_global*T%p_FAST%dt + t_initial + t_global_next = (n_t_global + 1)*T%p_FAST%dt + t_initial + + ! Set this_time based on state + ! TODO: figure out where to use each + select case (this_state) + case (STATE_CURR) + this_time = t_global + case (STATE_PRED) + this_time = t_global_next + end select + + ! Loop through modules to calculate output and state derivatives + do i = 1, size(ModOrder) + + ! Get module index + iMod = ModOrder(i) + + ! Get module instance index + iIns = Mods(iMod)%Instance + + ! Select based on module ID + select case (Mods(iMod)%ID) + +!------------------------------------------------------------------------------- +! Module_AD +!------------------------------------------------------------------------------- + + case (Module_AD) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + call AD_Input_ExtrapInterp(T%AD%Input, T%AD%InputTimes, T%AD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%AD%InputTimes(j + 1) = T%AD%InputTimes(j) + end do + call AD_CopyInput(T%AD%u, T%AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%AD%InputTimes(1) = t_global_next + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + call AD_InputSolve_NoIfW(T%p_FAST, T%AD%Input(1), T%SrvD%y, T%ED%y, T%BD, T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return + call AD_InputSolve_IfW(T%p_FAST, T%AD%Input(1), T%IfW%y, T%OpFM%y, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! UpdateStates + if (iand(EM_UpdateStates, EvalFlags) > 0) then + call AD_CopyContState(T%AD%x(STATE_CURR), T%AD%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyDiscState(T%AD%xd(STATE_CURR), T%AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyConstrState(T%AD%z(STATE_CURR), T%AD%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyOtherState(T%AD%OtherSt(STATE_CURR), T%AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + do j_ss = 1, Mods(iMod)%SubSteps + n_t_module = n_t_global*Mods(iMod)%SubSteps + j_ss - 1 + t_module = n_t_module*Mods(iMod)%DT + t_initial + call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, T%AD%p, T%AD%x(STATE_PRED), & + T%AD%xd(STATE_PRED), T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), T%AD%m, ErrStat2, ErrMsg2); if (Failed()) return + end do + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + call AD_CalcOutput(this_time, T%AD%Input(1), T%AD%p, T%AD%x(this_state), T%AD%xd(this_state), T%AD%z(this_state), & + T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep); if (Failed()) return + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_BD +!------------------------------------------------------------------------------- + + case (Module_BD) + + ! InitIO + if (iand(EM_InitIO, EvalFlags) > 0) then + T%BD%InputTimes(:, iIns) = t_initial - T%p_FAST%dt*[(j, j=0, T%p_FAST%InterpOrder)] + do j = 2, T%p_FAST%InterpOrder + 1 + call BD_CopyInput(T%BD%Input(1, iIns), T%BD%Input(j, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call BD_CopyInput(T%BD%Input(1, iIns), T%BD%u(iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyContState(T%BD%x(STATE_CURR, iIns), T%BD%x(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(STATE_CURR, iIns), T%BD%xd(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(STATE_CURR, iIns), T%BD%z(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(STATE_CURR, iIns), T%BD%OtherSt(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end if + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + call BD_Input_ExtrapInterp(T%BD%Input(:, iIns), T%BD%InputTimes(:, iIns), T%BD%u(iIns), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call BD_CopyInput(T%BD%Input(j, iIns), T%BD%Input(j + 1, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(j + 1, iIns) = T%BD%InputTimes(j, iIns) + end do + call BD_CopyInput(T%BD%u(iIns), T%BD%Input(1, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(1, iIns) = t_global_next + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + call Transfer_ED_to_BD(T%ED%y, T%BD%Input(1, :), T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return + call BD_InputSolve(T%p_FAST, T%BD, T%AD%y, T%AD%Input(1), T%ED%y, T%SrvD%y, T%SrvD%Input(1), T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + call BD_CopyContState(T%BD%x(STATE_CURR, iIns), T%BD%x(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(STATE_CURR, iIns), T%BD%xd(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(STATE_CURR, iIns), T%BD%z(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(STATE_CURR, iIns), T%BD%OtherSt(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + ! if (present(x)) call ED_UnpackStateValues(T%BD%p, x(T%BD%p%Vars%ix), T%BD%x(STATE_PRED)) + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + call BD_CalcOutput(this_time, T%BD%Input(iIns, 1), T%BD%p(iIns), T%BD%x(iIns, this_state), & + T%BD%xd(iIns, this_state), T%BD%z(iIns, this_state), T%BD%OtherSt(iIns, this_state), & + T%BD%y(iIns), T%BD%m(iIns), ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + call BD_CalcContStateDeriv(this_time, T%BD%Input(iIns, 1), T%BD%p(iIns), T%BD%x(iIns, this_state), & + T%BD%xd(iIns, this_state), T%BD%z(iIns, this_state), T%BD%OtherSt(iIns, this_state), & + T%BD%m(iIns), T%BD%dxdt(iIns), ErrStat2, ErrMsg2); if (Failed()) return + ! if (present(dxdt)) dxdt(T%BD%p(iIns)%Vars%ixg) = T%BD%m(iIns)%Vals%dxdt + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + ! call BD_JacobianPInput(this_time, T%BD%Input(1), T%BD%p, T%BD%x(this_state), T%BD%xd(this_state), & + ! T%BD%z(this_state), T%BD%OtherSt(this_state), T%BD%y, T%BD%m, & + ! ErrStat2, ErrMsg2, dYdu=T%BD%m%Vals%dYdu, dXdu=T%BD%m%Vals%dXdu); if (Failed()) return + ! if (present(dYdu)) dYdu(T%BD%p%Vars%iyg, T%BD%p%Vars%iug) = T%BD%m%Vals%dYdu + ! if (present(dXdu)) dXdu(T%BD%p%Vars%ixg, T%BD%p%Vars%iug) = T%BD%m%Vals%dXdu + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + ! call ED_JacobianPContState(this_time, T%BD%Input(1), T%BD%p, T%BD%x(this_state), T%BD%xd(this_state), & + ! T%BD%z(this_state), T%BD%OtherSt(this_state), T%BD%y, T%BD%m, & + ! ErrStat2, ErrMsg2, dYdx=T%BD%m%Vals%dYdx, dXdx=T%BD%m%Vals%dXdx); if (Failed()) return + ! if (present(dYdx)) dYdx(T%BD%p%Vars%iyg, T%BD%p%Vars%ixg) = T%BD%m%Vals%dYdx + ! if (present(dXdx)) dXdx(T%BD%p%Vars%ixg, T%BD%p%Vars%ixg) = T%BD%m%Vals%dXdx + end if + +!------------------------------------------------------------------------------- +! Module_ED +!------------------------------------------------------------------------------- + + case (Module_ED) + + ! InitIO - MESH_NEWCOPY is used to create/initialize the meshes + if (iand(EM_InitIO, EvalFlags) > 0) then + T%ED%InputTimes = t_initial - T%p_FAST%dt*[(j, j=0, T%p_FAST%InterpOrder)] + do j = 2, T%p_FAST%InterpOrder + 1 + call ED_CopyInput(T%ED%Input(1), T%ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyContState(T%ED%x(STATE_CURR), T%ED%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(STATE_CURR), T%ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(STATE_CURR), T%ED%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(STATE_CURR), T%ED%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end if + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + call ED_Input_ExtrapInterp(T%ED%Input, T%ED%InputTimes, T%ED%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%ED%InputTimes(j + 1) = T%ED%InputTimes(j) + end do + call ED_CopyInput(T%ED%u, T%ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%ED%InputTimes(1) = t_global_next + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + call ED_InputSolve(T%p_FAST, T%ED%Input(1), T%ED%y, T%AD14%p, T%AD14%y, T%AD%y, T%SrvD%y, & + T%AD%Input(1), T%SrvD%Input(1), T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! UpdateStates (tight coupling - state from solver) - MESH_UPDATECOPY is used to only update the meshes + if (iand(EM_UpdateStates, EvalFlags) > 0) then + call ED_CopyContState(T%ED%x(STATE_CURR), T%ED%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(STATE_CURR), T%ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(STATE_CURR), T%ED%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(STATE_CURR), T%ED%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + if (present(x)) call ED_UnpackStateValues(T%ED%p, x(T%ED%p%Vars%ixg), T%ED%x(STATE_PRED)) + end if + + ! SavePredStates - save predicted states to current states + if (iand(EM_SavePredStates, EvalFlags) > 0) then + call ED_CopyContState(T%ED%x(STATE_PRED), T%ED%x(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(STATE_PRED), T%ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(STATE_PRED), T%ED%z(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(STATE_PRED), T%ED%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + call ED_CalcOutput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + call ED_CalcContStateDeriv(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%m, & + T%ED%dxdt, ErrStat2, ErrMsg2, dxdtarr=T%ED%m%Vals%dxdt); if (Failed()) return + if (present(dxdt)) dxdt(T%ED%p%Vars%ixg) = T%ED%m%Vals%dxdt + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return + if (present(dYdu)) dYdu(T%ED%p%Vars%iyg, T%ED%p%Vars%iug) = T%ED%m%Vals%dYdu + if (present(dXdu)) dXdu(T%ED%p%Vars%ixg, T%ED%p%Vars%iug) = T%ED%m%Vals%dXdu + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + if (present(dYdx)) dYdx(T%ED%p%Vars%iyg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dYdx + if (present(dXdx)) dXdx(T%ED%p%Vars%ixg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dXdx + end if + +!------------------------------------------------------------------------------- +! Module_ExtPtfm +!------------------------------------------------------------------------------- + + case (Module_ExtPtfm) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_FEAM +!------------------------------------------------------------------------------- + + case (Module_FEAM) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_HD +!------------------------------------------------------------------------------- + + case (Module_HD) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_IceD +!------------------------------------------------------------------------------- + + case (Module_IceD) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_IceF +!------------------------------------------------------------------------------- + + case (Module_IceF) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_IfW +!------------------------------------------------------------------------------- + + case (Module_IfW) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + call InflowWind_Input_ExtrapInterp(T%IfW%Input, T%IfW%InputTimes, T%IfW%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%IfW%InputTimes(j + 1) = T%IfW%InputTimes(j) + end do + call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%IfW%InputTimes(1) = t_global_next + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + call InflowWind_CopyContState(T%IfW%x(STATE_CURR), T%IfW%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call InflowWind_CopyDiscState(T%IfW%xd(STATE_CURR), T%IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call InflowWind_CopyConstrState(T%IfW%z(STATE_CURR), T%IfW%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call InflowWind_CopyOtherState(T%IfW%OtherSt(STATE_CURR), T%IfW%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + do j_ss = 1, Mods(iMod)%SubSteps + n_t_module = n_t_global*Mods(iMod)%SubSteps + j_ss - 1 + t_module = n_t_module*Mods(iMod)%DT + t_initial + call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & + T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return + end do + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_MAP +!------------------------------------------------------------------------------- + + case (Module_MAP) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_MD +!------------------------------------------------------------------------------- + + case (Module_MD) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_OpFM +!------------------------------------------------------------------------------- + + case (Module_OpFM) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_Orca +!------------------------------------------------------------------------------- + + case (Module_Orca) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_SD +!------------------------------------------------------------------------------- + + case (Module_SD) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_SeaSt +!------------------------------------------------------------------------------- + + case (Module_SeaSt) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Module_SrvD +!------------------------------------------------------------------------------- + + case (Module_SrvD) + + ! ExtrapInterp + if (iand(EM_ExtrapInterp, EvalFlags) > 0) then + call SrvD_Input_ExtrapInterp(T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes(j + 1) = T%SrvD%InputTimes(j) + end do + call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes(1) = t_global_next + end if + + ! InputSolve + if (iand(EM_InputSolve, EvalFlags) > 0) then + end if + + ! UpdateStates (tight coupling - state from solver) + if (iand(EM_UpdateStates, EvalFlags) > 0) then + call SrvD_CopyContState(T%SrvD%x(STATE_CURR), T%SrvD%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyDiscState(T%SrvD%xd(STATE_CURR), T%SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyConstrState(T%SrvD%z(STATE_CURR), T%SrvD%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOtherState(T%SrvD%OtherSt(STATE_CURR), T%SrvD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + do j_ss = 1, Mods(iMod)%SubSteps + n_t_module = n_t_global*Mods(iMod)%SubSteps + j_ss - 1 + t_module = n_t_module*Mods(iMod)%DT + t_initial + call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & + T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + end do + end if + + ! CalcOutput + if (iand(EM_CalcOutput, EvalFlags) > 0) then + call SrvD_CalcOutput(this_time, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(this_state), T%SrvD%xd(this_state), T%SrvD%z(this_state), & + T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! CalcContStateDeriv + if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then + end if + + ! JacobianPInput + if (iand(EM_JacobianPInput, EvalFlags) > 0) then + end if + + ! JacobianPContState + if (iand(EM_JacobianPContState, EvalFlags) > 0) then + end if + +!------------------------------------------------------------------------------- +! Unknown module +!------------------------------------------------------------------------------- + + case default + + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mods(iMod)%ID)), ErrStat, ErrMsg, RoutineName) + + end select + end do + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +end module diff --git a/modules/openfast-library/src/FAST_Lin_TC.f90 b/modules/openfast-library/src/FAST_Lin_TC.f90 new file mode 100644 index 0000000000..fef1ba292e --- /dev/null +++ b/modules/openfast-library/src/FAST_Lin_TC.f90 @@ -0,0 +1,6964 @@ +!********************************************************************************************************************************** +! FAST_Solver.f90, FAST_Subs.f90, FAST_Lin.f90, and FAST_Mods.f90 make up the FAST glue code in the FAST Modularization Framework. +! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! Copyright (C) 2018 Envision Energy USA, LTD +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +MODULE FAST_Linear + + ! USE FAST_Solver ! I mostly just want the modules that are inherited from this module, not the routines in it + USE FAST_ModTypes + + USE AeroDyn + USE AeroDyn14 + USE InflowWind + USE ElastoDyn + USE BeamDyn + USE FEAMooring + USE MoorDyn + USE MAP + USE OrcaFlexInterface + USE SeaState + USE HydroDyn + USE IceDyn + USE IceFloe + USE ServoDyn + USE SubDyn + USE OpenFOAM + Use ExtPtfm_MCKF + + IMPLICIT NONE + + CONTAINS +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that initializes some variables for linearization. +SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, NumBlNodes, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + INTEGER(IntKi), INTENT(IN ) :: NumBl !< Number of blades (for index into ED,AD input array) + INTEGER(IntKi), INTENT(IN ) :: NumBlNodes !< Number of blade nodes (for index into AD input array) + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: i, j, k ! loop/temp variables + INTEGER(IntKi) :: ThisModule ! Module ID # + INTEGER(IntKi) :: NumInstances ! Number of instances of each module + INTEGER(IntKi) :: NumStates ! Number of states required for the x_eig arrays + + INTEGER(IntKi) :: i_u ! loop/temp variables + INTEGER(IntKi) :: i_y, i_x ! loop/temp variables + + INTEGER(IntKi) :: NextStart(3) ! allocated to be size(LinStartIndx)=size(SizeLin); helps compute the next starting index for the module components + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'Init_Lin' + CHARACTER(200) :: ModAbrev + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------- + ! determine the number of modules that will be linearized: + !---------------------------------------------------------------------------- + + p_FAST%Lin_NumMods = 0 + + ! InflowWind is first, if activated: + if ( p_FAST%CompInflow == Module_IfW ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_IfW + call Init_Lin_IfW( p_FAST, y_FAST, AD%Input(1) ) ! overwrite some variables based on knowledge from glue code + end if + + ! ServoDyn is next, if activated: + if ( p_FAST%CompServo == Module_SrvD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_SrvD + end if + + ! ElastoDyn is next; it is always activated: + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_ED + + ! BeamDyn is next, if activated: + if (p_FAST%CompElast == Module_BD) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_BD + end if + + ! AeroDyn is next, if activated: + if ( p_FAST%CompAero == Module_AD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_AD + end if + + ! HydroDyn is next, if activated: + if ( p_FAST%CompHydro == Module_HD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_HD + end if + + ! SD or ExtPtfm is next, if activated: + if ( p_FAST%CompSub == Module_SD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_SD + else if ( p_FAST%CompSub == Module_ExtPtfm ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_ExtPtfm + end if + + ! MAP is next, if activated: + if ( p_FAST%CompMooring == Module_MAP ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_MAP + else if ( p_FAST%CompMooring == Module_MD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_MD + end if + + !..................... + ! determine total number of inputs/outputs/contStates: + !..................... + + y_FAST%Lin%Glue%SizeLin = 0 + y_FAST%Lin%Glue%NumOutputs = 0 + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin = 0 + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_u)) y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_INPUT_COL) = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_u) + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_y)) y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_y) + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x)) y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x) + + y_FAST%Lin%Glue%SizeLin = y_FAST%Lin%Glue%SizeLin + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin ! total number of inputs, outputs, and continuous states + + y_FAST%Lin%Glue%NumOutputs = y_FAST%Lin%Glue%NumOutputs + y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs ! total number of WriteOutputs + end do + end do + + !..................... + ! compute the starting index in the combined (full) matrices: + !..................... + NextStart = 1 ! whole array + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx = NextStart + NextStart = NextStart + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin + end do + end do + + + ! ................................... + ! determine which of the module inputs/outputs are written to file + ! ................................... + call Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! ................................... + ! get names of inputs, outputs, and continuous states + ! ................................... + call AllocAry( y_FAST%Lin%Glue%names_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'names_u', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%names_y, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'names_y', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%names_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'names_x', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%Use_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'use_u', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%Use_y, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'use_y', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%RotFrame_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'RotFrame_u', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%RotFrame_y, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'RotFrame_y', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%RotFrame_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'RotFrame_x', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%DerivOrder_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'DerivOrder_x', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%IsLoad_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'IsLoad_u', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) return + + + i_u = 1 + i_y = 1 + i_x = 1 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + ModAbrev = y_FAST%Module_Abrev(ThisModule) + NumInstances = size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ! inputs + do k=1,NumInstances + if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then + ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) + end if + + do j=1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_INPUT_COL) + y_FAST%Lin%Glue%names_u(i_u) = TRIM(ModAbrev)//' '//y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_u(j) + y_FAST%Lin%Glue%use_u( i_u) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_u(j) + y_FAST%Lin%Glue%IsLoad_u(i_u) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%IsLoad_u(j) + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_u)) then + y_FAST%Lin%Glue%RotFrame_u(i_u) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_u(j) + else + y_FAST%Lin%Glue%RotFrame_u(i_u) = .false. + end if + i_u = i_u + 1; + end do + + end do + + ! outputs + do k=1,NumInstances + if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then + ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) + end if + + do j=1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) + y_FAST%Lin%Glue%names_y(i_y) = TRIM(ModAbrev)//' '//y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_y(j) + y_FAST%Lin%Glue%use_y( i_y) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y(j) + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_y)) then + y_FAST%Lin%Glue%RotFrame_y(i_y) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_y(j) + else + y_FAST%Lin%Glue%RotFrame_y(i_y) = .false. + end if + i_y = i_y + 1; + end do + end do + + ! continuous states + do k=1,NumInstances + if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then + ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) + end if + + if (y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) > 0) then + if (p_FAST%WrVTK == VTK_ModeShapes) then ! allocate these for restart later + if (ThisModule == Module_ED) then + ! ED has only the active DOFs as the continuous states, but to perturb the OP [Perterb_OP()], we need all of the DOFs + NumStates = ED%p%NDOF*2 + else + NumStates = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + end if + + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag, NumStates, 'op_x_eig_mag', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase, NumStates, 'op_x_eig_phase', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) return + + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag = 0.0_R8Ki + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase = 0.0_R8Ki + end if + end if + + + do j=1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%names_x( i_x) = TRIM(ModAbrev)//' '//y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x( j) + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_x)) then + y_FAST%Lin%Glue%RotFrame_x(i_x) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_x(j) + else + y_FAST%Lin%Glue%RotFrame_x(i_x) = .false. + end if + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%DerivOrder_x)) then + y_FAST%Lin%Glue%DerivOrder_x(i_x) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%DerivOrder_x(j) + else + y_FAST%Lin%Glue%DerivOrder_x(i_x) = 0 + end if + i_x = i_x + 1; + end do + end do + + end do ! each module + + + !..................... + ! initialize variables for periodic steady state solution + !..................... + + m_FAST%Lin%NextLinTimeIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_NEWCOPY + m_FAST%Lin%n_rot = 0 + m_FAST%Lin%IsConverged = .false. + m_FAST%Lin%FoundSteady = .false. + m_FAST%Lin%ForceLin = .false. + m_FAST%Lin%AzimIndx = 1 + + p_FAST%AzimDelta = TwoPi / p_FAST%NLinTimes + + ! allocate space to save operating points + if (p_FAST%CalcSteady .or. p_FAST%WrVTK==VTK_ModeShapes) then + + call AllocateOP(p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! allocate spaces for variables needed to determine + if (p_FAST%CalcSteady) then + + !call AllocAry(m_FAST%Lin%AzimTarget, p_FAST%NLinTimes,'AzimTarget', ErrStat2, ErrMsg2) + allocate( m_FAST%Lin%AzimTarget(0 : p_FAST%NLinTimes+1), stat=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal,"Unable to allocate space for AzimTarget.",ErrStat,ErrMsg,RoutineName) + end if + + call AllocAry( m_FAST%Lin%LinTimes, p_FAST%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Psi, p_FAST%LinInterpOrder+1, 'Psi', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! these flattened output arrays will contain spaces for %WriteOutputs, which are being ignored for purposes of CalcSteady computations + call AllocAry( m_FAST%Lin%y_interp, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_interp', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Y_prevRot, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), p_FAST%NLinTimes, 'Y_prevRot', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%y_ref, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_ref', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat < AbortErrLev) then + m_FAST%Lin%y_interp = 0.0_R8Ki + m_FAST%Lin%Y_prevRot = 0.0_R8Ki + m_FAST%Lin%y_ref = 1.0_R8Ki + end if + + end if + + end if + + +END SUBROUTINE Init_Lin +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that initializes the names and rotating frame portion of IfW. +SUBROUTINE Init_Lin_IfW( p_FAST, y_FAST, u_AD ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn + + INTEGER(IntKi) :: i, j, k ! loop counters + INTEGER(IntKi) :: i2 ! loop counters + INTEGER(IntKi) :: Node ! InflowWind node number + CHARACTER(25) :: NodeDesc ! Node description + INTEGER(IntKi) :: position ! position in string + + + ! compare with IfW_InputSolve(): + + Node = 0 !InflowWind node + + ! I'm going to overwrite some of the input/output descriptions + if (p_FAST%CompServo == MODULE_SrvD) then + Node = Node + 1 + NodeDesc = ' (hub)' + + do i=1,3 + position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i), ',') - 1 + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i)(1:position)//trim(NodeDesc)//& + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i)(position+1:) + end do + do i=1,3 + position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i), ',') - 1 + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i)(1:position)//trim(NodeDesc)//& + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i)(position+1:) + end do + end if + + IF (p_FAST%CompAero == MODULE_AD) THEN + + DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) + DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes + Node = Node + 1 ! InflowWind node + NodeDesc = ' (blade '//trim(num2lstr(k))//', node '//trim(num2lstr(j))//')' + + do i=1,3 !XYZ components of this node + i2 = (Node-1)*3 + i + + position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2), ',') - 1 + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(1:position)//trim(NodeDesc)//& + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(position+1:) + + position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2), ',') - 1 + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(1:position)//trim(NodeDesc)//& + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(position+1:) + + ! IfW has inputs and outputs in the global frame + !y_FAST%Lin%Modules(Module_IfW)%Instance(1)%RotFrame_u(i2) = .true. + !y_FAST%Lin%Modules(Module_IfW)%Instance(1)%RotFrame_y(i2) = .true. + + end do + END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements + END DO !K = 1,p%NumBl + + ! tower: + DO J=1,u_AD%rotors(1)%TowerMotion%nnodes + Node = Node + 1 + NodeDesc = ' (Tower node '//trim(num2lstr(j))//')' + + do i=1,3 !XYZ components of this node + i2 = (Node-1)*3 + i + + position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2), ',') - 1 + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(1:position)//trim(NodeDesc)//& + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(position+1:) + + position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2), ',') - 1 + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(1:position)//trim(NodeDesc)//& + y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(position+1:) + end do + END DO + + END IF + +END SUBROUTINE Init_Lin_IfW +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that initializes some use_u and use_y, which determine which, if any, inputs and outputs are output in the linearization file. +SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + INTEGER(IntKi), INTENT(IN ) :: NumBl !< Number of blades (for index into ED,AD input array) + INTEGER(IntKi), INTENT(IN ) :: NumBlNodes !< Number of blades nodes (for index into AD input array) + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: i, j, col ! loop/temp variables + INTEGER(IntKi) :: k ! loop/temp variables + INTEGER(IntKi) :: ThisModule ! Module ID # + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'Init_Lin_InputOutput' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! ................................... + ! allocate module arrays + ! ................................... + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + call AllocAry ( y_FAST%Lin%Modules(ThisModule)%Instance(k)%Use_u, size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_u), TRIM(y_FAST%Module_Abrev(ThisModule))//'_Use_u', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry ( y_FAST%Lin%Modules(ThisModule)%Instance(k)%Use_y, size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_y), TRIM(y_FAST%Module_Abrev(ThisModule))//'_Use_y', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end do + + end do + if (ErrStat >= AbortErrLev) return + + + ! ................................... + ! set true/false flags for inputs: + ! ................................... + + if (p_FAST%LinInputs == LIN_NONE) then + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_u = .false. + end do + end do + elseif(p_FAST%LinInputs == LIN_STANDARD) then + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_u = .false. + end do + end do + + ! AD standard inputs: UserProp(NumBlNodes,NumBl) + if (p_FAST%CompAero == MODULE_AD) then + do j=1,NumBl*NumBlNodes + y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + end do + end if + + ! ED standard inputs: BlPitchCom, YawMom, GenTrq, extended input (collective pitch) + do j=1,NumBl+3 + y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + end do + + ! IfW standard inputs: HWindSpeed, PLexp, PropagationDir + if (p_FAST%CompInflow == MODULE_IfW) then + do j = 1,3 + y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + end do + end if + + ! HD standard inputs: WaveElev0 + if (p_FAST%CompHydro == MODULE_HD) then + y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)) = .true. + end if + + ! SD has no standard inputs + + elseif(p_FAST%LinInputs == LIN_ALL) then + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_u = .true. + end do + end do + end if + + + ! ................................... + ! set true/false flags for outputs: + ! ................................... + + if (p_FAST%LinOutputs == LIN_NONE) then + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y = .false. + end do + end do + elseif(p_FAST%LinOutputs == LIN_STANDARD) then + + ! WriteOutput values are the last entries of the modules + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !last column before WriteOutput occurs + do j=1,col + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y(j) = .false. + end do + do j=col+1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y(j) = .true. + end do + end do + end do + + elseif(p_FAST%LinOutputs == LIN_ALL) then + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y = .true. + end do + end do + end if + + +END SUBROUTINE Init_Lin_InputOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that performs lineaization at current operating point for a turbine. +SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: Un ! unit number for linearization output file (written in two parts) + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' + + REAL(R8Ki), ALLOCATABLE :: dUdu(:,:), dUdy(:,:) ! variables for glue-code linearization + integer(intki) :: NumBl + integer(intki) :: k + CHARACTER(1024) :: LinRootName + CHARACTER(1024) :: OutFileName + CHARACTER(200) :: SimStr + CHARACTER(MaxWrScrLen) :: BlankLine + CHARACTER(*), PARAMETER :: Fmt = 'F10.2' + + + + ErrStat = ErrID_None + ErrMsg = "" + Un = -1 + + !..................... + SimStr = '(RotSpeed='//trim(num2lstr(ED%y%RotSpeed*RPS2RPM,Fmt))//' rpm, BldPitch1='//trim(num2lstr(ED%y%BlPitch(1)*R2D,Fmt))//' deg)' + + BlankLine = "" + CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces + CALL WrOver ( ' Performing linearization '//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM( Num2LStr(t_global) )//' s. '//trim(SimStr) ) + CALL WrScr('') + + !..................... + + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) + + if (p_FAST%WrVTK == VTK_ModeShapes .and. .not. p_FAST%CalcSteady) then ! we already saved these for the CalcSteady case + call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + !m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY ! we need a new copy for each LinTime + end if + + + NumBl = size(ED%Input(1)%BlPitchCom) + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa + !..................... + ! ElastoDyn + !..................... + ! get the jacobians + call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ED)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dXdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) + + !dXdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_u ) + + ! dYdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_y ) + + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_u ) + + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ED)%Instance(1) ) + + end if + + !..................... + ! BeamDyn + !..................... + if ( p_FAST%CompElast == Module_BD ) then + do k=1,p_FAST%nBeams + + ! get the jacobians + call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & + StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & + StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & + StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & + x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM(num2lstr(k)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_BD)%Instance(k), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dXdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, Un, p_FAST%OutFmt, 'dXdx' ) + + !dXdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_u ) + + !dYdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_y ) + + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_BD)%Instance(k) ) + end if + + end do + end if !BeamDyn + + + !..................... + ! InflowWind + !..................... + if ( p_FAST%CompInflow == Module_IfW ) then + + ! get the jacobians + call InflowWind_JacobianPInput( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_IfW)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_IfW)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & + UseRow=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%use_y, UseCol=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_IfW)%Instance(1) ) + + end if + + end if + + !..................... + ! ServoDyn + !..................... + if ( p_FAST%CompServo == Module_SrvD ) then + ! get the jacobians + call SrvD_JacobianPInput( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & + dXdu=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%B, & + dYdu=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call SrvD_JacobianPContState( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & + dYdx=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%C, & + dXdx=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & + u_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_u, & + dx_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_dx, & + x_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_x, & + y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_SrvD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! Jacobians + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_u) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_y) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_u) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_SrvD)%Instance(1) ) + + end if + end if + + !..................... + ! AeroDyn + !..................... + if ( p_FAST%CompAero == Module_AD ) then + ! get the jacobians + call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & + dXdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%B, & + dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call AD_JacobianPContState( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & + dXdx=y_FAST%Lin%Modules(Module_AD)%Instance(1)%A, & + dYdx=y_FAST%Lin%Modules(Module_AD)%Instance(1)%C ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & + u_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_AD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) + + call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', & + UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) + + call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', & + UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y ) + + call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & + UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1) ) + end if + + end if + + + !..................... + ! HydroDyn + !..................... + if ( p_FAST%CompHydro == Module_HD ) then + ! get the jacobians + call HD_JacobianPInput( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%B ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call HD_JacobianPContState( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_HD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dXdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) + + !dXdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_u ) + + !dYdx: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_y ) + + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_u ) + + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_HD)%Instance(1) ) + + end if + end if + + !..................... + ! SubDyn / ExtPtfm + !..................... + + if ( p_FAST%CompSub == Module_SD ) then + ! get the jacobians + call SD_JacobianPInput( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), & + SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), SD%y, SD%m, ErrStat2, ErrMsg2, & + dYdu=y_FAST%Lin%Modules(Module_SD)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_SD)%Instance(1)%B ) + if(Failed()) return; + + call SD_JacobianPContState( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), & + SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), SD%y, SD%m, ErrStat2, ErrMsg2,& + dYdx=y_FAST%Lin%Modules(Module_SD)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_SD)%Instance(1)%A ) + if(Failed()) return; + + ! get the operating point + call SD_GetOP(t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR),& + SD%OtherSt(STATE_CURR), SD%y, SD%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_u,& + y_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_dx) + if(Failed()) return; + + ! write the module matrices: + if (p_FAST%LinOutMod) then + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_SD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_SD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) + if(Failed()) return; + + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_u) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_y) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_u) + end if + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_SD)%Instance(1) ) + end if + elseif ( p_FAST%CompSub == Module_ExtPtfm ) then + ! get the jacobians + call ExtPtfm_JacobianPInput( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & + ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B ) + if(Failed()) return; + + call ExtPtfm_JacobianPContState( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & + ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2,& + dYdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A ) + if(Failed()) return; + + ! get the operating point + call ExtPtfm_GetOP(t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR),& + ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_u,& + y_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_dx) + if(Failed()) return; + + ! write the module matrices: + if (p_FAST%LinOutMod) then + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) + if(Failed()) return; + + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) + end if + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1) ) + end if + end if ! SubDyn/ExtPtfm + + + !..................... + ! MAP + !..................... + if ( p_FAST%CompMooring == Module_MAP ) then + ! LIN-TODO: We need this to compute the dYdu total derivative which is D for MAP, and the template uses OtherSt(STATE_CURR), but the FAST MAP DATA has OtherSt as a scalar + call MAP_JacobianPInput( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), & + MAPp%OtherSt, MAPp%y, ErrStat2, ErrMsg2, y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + !LIN-TODO: template uses OtherSt(STATE_CURR), but the FAST MAP DATA has OtherSt as a scalar + ! email bonnie for a discussion on this. + call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), & + MAPp%OtherSt, MAPp%y, ErrStat2, ErrMsg2, & + y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_u, y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_MAP)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_MAP)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & + UseRow=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_MAP)%Instance(1) ) + + end if ! if ( p_FAST%LinOutMod ) + end if ! if ( p_FAST%CompMooring == Module_MAP ) + + + !..................... + ! MoorDyn + !..................... + if ( p_FAST%CompMooring == Module_MD ) then + + call MD_JacobianPInput( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, ErrStat2, ErrMsg2, & + dXdu=y_FAST%Lin%Modules(Module_MD)%Instance(1)%B, & + dYdu=y_FAST%Lin%Modules(Module_MD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call MD_JacobianPContState( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & + MD%y, MD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_MD)%Instance(1)%C, & + dXdx=y_FAST%Lin%Modules(Module_MD)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call MD_GetOP( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, ErrStat2, ErrMsg2, & + u_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_MD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_MD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + ! dXdx, dXdu, dYdx, dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_u ) + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_y ) + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_MD)%Instance(1) ) + + end if ! if ( p_FAST%LinOutMod ) + end if ! if ( p_FAST%CompMooring == Module_MD ) + + !..................... + ! Linearization of glue code Input/Output solve: + !..................... + + !..................... + ! Glue code (currently a linearization of SolveOption2): + ! Make sure we avoid any case where the operating point values change earlier in this routine (e.g., by calling the module Jacobian routines). + !..................... + + call Glue_GetOP(p_FAST, y_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! get the dUdu and dUdy matrices, which linearize SolveOption2 for the modules we've included in linearization + call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & + IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix( dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_u ) + call WrPartialMatrix( dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) + end if + + + ! calculate the glue-code state matrices + call Glue_StateMatrices( p_FAST, y_FAST, dUdu, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! Write the results to the file: + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + + m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 + +contains + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + if(Failed) call cleanup() + end function Failed + subroutine cleanup() + + if (allocated(dUdu)) deallocate(dUdu) + if (allocated(dUdy)) deallocate(dUdy) + + if (Un > 0) close(Un) + + end subroutine cleanup +END SUBROUTINE FAST_Linearize_OP +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that writes the A,B,C,D matrices from linearization to a text file. +SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ErrStat, ErrMsg) + + INTEGER(IntKi), INTENT( OUT) :: Un !< unit number + REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(FAST_LinType), INTENT(IN ) :: LinData !< Linearization data for individual module or glue (coupled system) + CHARACTER(*), INTENT(IN ) :: FileName !< root name of the linearization file to open for writing + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i ! loop counter + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'WrLinFile_txt_Head' + INTEGER(IntKi) :: n(5) ! sizes of arrays to print + CHARACTER(*), PARAMETER :: TypeNames(5) = (/ 'continuous states', & + 'discrete states ', & + 'constraint states', & + 'inputs ', & + 'outputs ' /) + CHARACTER(50) :: Fmt + CHARACTER(32) :: Desc + + integer, parameter :: Indx_x = 1 + integer, parameter :: Indx_xd = 2 + integer, parameter :: Indx_z = 3 + integer, parameter :: Indx_u = 4 + integer, parameter :: Indx_y = 5 + + + ErrStat = ErrID_None + ErrMsg = "" + + n = 0; + if (allocated(LinData%names_x )) n(Indx_x) = size(LinData%names_x ) + if (allocated(LinData%names_xd)) n(Indx_xd) = size(LinData%names_xd) + if (allocated(LinData%names_z )) n(Indx_z) = size(LinData%names_z ) + !if (allocated(LinData%names_u )) n(Indx_u) = size(LinData%names_u ) + !if (allocated(LinData%names_y )) n(Indx_y) = size(LinData%names_y ) + + if (allocated(LinData%names_u )) then + do i=1,size(LinData%use_u) + if (LinData%use_u(i)) n(Indx_u) = n(Indx_u)+1 + end do + end if + + if (allocated(LinData%names_y )) then + do i=1,size(LinData%use_y) + if (LinData%use_y(i)) n(Indx_y) = n(Indx_y)+1 + end do + end if + + + CALL GetNewUnit( Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + Un = -1 + return + end if + + CALL OpenFOutFile ( Un, TRIM(FileName)//'.lin', ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + close( Un ) + Un = -1 + return + end if + + ! heading + + ! Add some file information: + + WRITE (Un,'(/,A)') 'Linearized model: '//TRIM( y_FAST%FileDescLines(1) ) + WRITE (Un,'(1X,A)') TRIM( y_FAST%FileDescLines(2) ) + WRITE (Un,'()' ) !print a blank line + WRITE (Un,'(A)' ) TRIM( y_FAST%FileDescLines(3) ) + WRITE (Un,'()' ) !print a blank line + + WRITE(Un, '(A)') 'Simulation information:' + fmt = '(3x,A,1x,'//trim(p_FAST%OutFmt_t)//',1x,A)' + Desc = 'Simulation time:'; WRITE (Un, fmt) Desc, t_global, 's' + Desc = 'Rotor Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%RotSpeed, 'rad/s' + Desc = 'Azimuth:'; WRITE (Un, fmt) Desc, y_FAST%Lin%Azimuth, 'rad' + Desc = 'Wind Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%WindSpeed, 'm/s' + + fmt = '(3x,A,1x,I5)' + do i=1,size(n) + Desc = 'Number of '//trim(TypeNames(i))//':' + WRITE(Un, fmt) Desc, n(i) + end do + + Desc = 'Jacobians included in this file?' + fmt = '(3x,A,1x,A5)' + if (p_FAST%LinOutJac) then + write (Un, fmt) Desc, 'Yes' + else + write (Un, fmt) Desc, 'No' + end if + + WRITE (Un,'()' ) !print a blank line + + + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + if (n(Indx_x) > 0) then + WRITE(Un, '(A)') 'Order of continuous states:' + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) + + WRITE(Un, '(A)') 'Order of continuous state derivatives:' + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) + end if + + if (n(Indx_xd) > 0) then + WRITE(Un, '(A)') 'Order of discrete states:' + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_xd, LinData%names_xd ) + end if + + if (n(Indx_z) > 0) then + WRITE(Un, '(A)') 'Order of constraint states:' + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_z, LinData%names_z, rotFrame=LinData%RotFrame_z ) + end if + + if (n(Indx_u) > 0) then + WRITE(Un, '(A)') 'Order of inputs:' + call WrLinFile_txt_Table(p_FAST, Un, "Column ", LinData%op_u, LinData%names_u, rotFrame=LinData%RotFrame_u, UseCol=LinData%use_u ) + end if + + if (n(Indx_y) > 0) then + WRITE(Un, '(A)') 'Order of outputs:' + call WrLinFile_txt_Table(p_FAST, Un, "Row ", LinData%op_y, LinData%names_y, rotFrame=LinData%RotFrame_y, UseCol=LinData%use_y ) + end if + + !............. + if (p_FAST%LinOutJac) then + WRITE (Un,'(/,A,/)' ) 'Jacobian matrices:' !print a blank line + ! we'll have the modules write their own Jacobians outside this routine + end if + + +END SUBROUTINE WrLinFile_txt_Head +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that writes the A,B,C,D matrices from linearization to a text file. +SUBROUTINE WrLinFile_txt_End(Un, p_FAST, LinData) + + INTEGER(IntKi), INTENT(INOUT) :: Un !< unit number + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters + TYPE(FAST_LinType), INTENT(IN ) :: LinData !< Linearization data for individual module or glue (coupled system) + + ! local variables + + WRITE (Un,'(/,A,/)' ) 'Linearized state matrices:' !print a blank line + + ! A matrix + if (allocated(LinData%A)) call WrPartialMatrix( LinData%A, Un, p_FAST%OutFmt, 'A' ) + ! B matrix + if (allocated(LinData%B)) call WrPartialMatrix( LinData%B, Un, p_FAST%OutFmt, 'B', UseCol=LinData%use_u ) + + ! C matrix + if (allocated(LinData%C)) call WrPartialMatrix( LinData%C, Un, p_FAST%OutFmt, 'C', UseRow=LinData%use_y ) + ! D matrix + if (allocated(LinData%D)) call WrPartialMatrix( LinData%D, Un, p_FAST%OutFmt, 'D', UseRow=LinData%use_y, UseCol=LinData%use_u ) + + ! StateRotation matrix + if (allocated(LinData%StateRotation)) call WrPartialMatrix( LinData%StateRotation, Un, p_FAST%OutFmt, 'StateRotation' ) + + ! RelState matrices + if (allocated(LinData%StateRel_x)) call WrPartialMatrix( LinData%StateRel_x, Un, p_FAST%OutFmt, 'State_Rel_x' ) + if (allocated(LinData%StateRel_xdot)) call WrPartialMatrix( LinData%StateRel_xdot, Un, p_FAST%OutFmt, 'State_Rel_xdot' ) + + close(Un) + Un = -1 + +END SUBROUTINE WrLinFile_txt_End +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, derivOrder, UseCol,start_indx) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters + INTEGER(IntKi), INTENT(IN ) :: Un !< unit number + CHARACTER(*), INTENT(IN ) :: RowCol !< Row/Column description + REAL(ReKi), INTENT(IN ) :: op(:) !< operating point values (possibly different size that Desc because of orientations) + CHARACTER(LinChanLen), INTENT(IN ) :: names(:) !< Descriptions of the channels (names and units) + logical, optional, INTENT(IN ) :: rotFrame(:) !< determines if this parameter is in the rotating frame + logical, optional, intent(in ) :: deriv !< flag that tells us if we need to modify the channel names for derivatives (xdot) + integer(IntKi), optional, intent(in ) :: derivOrder(:) !< Order of the time derivatives associated with the channel + logical, optional, intent(in ) :: UseCol(:) !< flags that tell us if we should use each column or skip it + INTEGER(IntKi),optional, INTENT(IN ) :: start_indx !< starting index (so extended inputs can be numbered starting after the # of inputs) + + ! local variables + INTEGER(IntKi) :: TS ! tab stop column + INTEGER(IntKi) :: i, j, i_print ! loop counter + INTEGER(IntKi) :: i_op ! loop counter + + logical :: UseDerivNames !< flag that tells us if we need to modify the channel names for derivatives (xdot) + logical :: UseThisCol !< flag that tells us if we should use this particular column or skip it + logical :: RotatingCol !< flag that tells us if this column is in the rotating frame + integer(IntKi) :: DerivOrdCol !< integer indicating the maximum time-derivative order of a channel (this will be 0 for anything that is not a continuous state) + CHARACTER(*), PARAMETER :: RoutineName = 'WrLinFile_txt_Table' + CHARACTER(100) :: Fmt + CHARACTER(100) :: Fmt_Str + CHARACTER(100) :: FmtOrient + real(R8Ki) :: DCM(3,3) + + + + if (present(deriv) ) then + UseDerivNames = deriv + else + UseDerivNames = .false. + end if + + + TS = 14 + 3*p_FAST%FmtWidth+7 ! tab stop after operating point + + Fmt = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',T'//trim(num2lstr(TS))//',L8,8x,I8,9x,A)' + FmtOrient = '(3x,I8,3x,'//trim(p_FAST%OutFmt)//',2(", ",'//trim(p_FAST%OutFmt)//'),T'//trim(num2lstr(TS))//',L8,8x,I8,9x,A)' + Fmt_Str = '(3x,A10,1x,A,T'//trim(num2lstr(TS))//',A15,1x,A16,1x,A)' + + WRITE(Un, Fmt_Str) RowCol, 'Operating Point', 'Rotating Frame?', 'Derivative Order', 'Description' + WRITE(Un, Fmt_Str) '----------','---------------', '---------------', '----------------', '-----------' + + i_op = 1 + if (present(start_indx)) then + i_print = start_indx + 1 + else + i_print = 1 + end if + + do i=1,size(names) + + UseThisCol = .true. + if (present(UseCol)) then + UseThisCol = useCol(i) + end if + + DerivOrdCol = 0 + if (present(derivOrder)) DerivOrdCol = derivOrder(i) + + RotatingCol = .false. + if (present(rotFrame)) RotatingCol = rotFrame(i) + + if (index(names(i), ' orientation angle, node ') > 0 ) then ! make sure this matches what is written in PackMotionMesh_Names() + if (names(i)(1:2) == "ED") then + if (UseThisCol) then + if (index(names(i), 'X orientation') > 0) then + j = 1 + else if (index(names(i), 'Y orientation') > 0) then + j = 2 + else if (index(names(i), 'Z orientation') > 0) then + j = 3 + end if + DCM = wm_to_dcm(op(i_op-j+1:i_op-j+3)) + WRITE(Un, FmtOrient) i_print, DCM(j,1), DCM(j,2), DCM(j,3), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 + end if + i_op = i_op + 1 + else + if (UseThisCol) then + WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 + end if + i_op = i_op + 3 + end if + + else + if (UseThisCol) then + if (UseDerivNames) then + WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, 'First time derivative of '//trim(names(i))//'/s' + else + WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, trim(names(i)) + end if + i_print = i_print + 1 + end if + + i_op = i_op + 1 + end if + end do + + WRITE (Un,'()' ) !print a blank line + + + +END SUBROUTINE WrLinFile_txt_Table +!---------------------------------------------------------------------------------------------------------------------------------- + + +!> This routine returns the operating points for the entire glue code. +SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameters + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + INTEGER(IntKi) :: i, j, k ! loop/temp variables + INTEGER(IntKi) :: ThisModule ! Module ID # + INTEGER(IntKi) :: i_u ! loop/temp variables + INTEGER(IntKi) :: i_y, i_x ! loop/temp variables + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'Glue_GetOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + if (.not. allocated(y_FAST%Lin%Glue%op_u)) then ! assume none of them are allocated + + ! calculate the size of the input and output operating points + ! this size isn't very straightforward since it may contain orientations + i_u = 0 + i_y = 0 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_u)) then + i_u = i_u + size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_u) + end if + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_y)) then + i_y = i_y + size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_y) + end if + end do + end do + + call AllocAry( y_FAST%Lin%Glue%op_u, i_u, 'op_u', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%op_y, i_y, 'op_y', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%op_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'op_x', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Glue%op_dx, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'op_dx', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >=AbortErrLev) return + end if + + + i_u = 1 + i_y = 1 + i_x = 1 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_u)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_u) + y_FAST%Lin%Glue%op_u(i_u) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_u(j) + i_u = i_u + 1; + end do + end if + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_y)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_y) + y_FAST%Lin%Glue%op_y(i_y) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_y(j) + i_y = i_y + 1; + end do + end if + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x) + y_FAST%Lin%Glue%op_x(i_x) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x(j) + + y_FAST%Lin%Glue%op_dx(i_x) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_dx(j) + i_x = i_x + 1; + end do + end if + + end do + end do + +END SUBROUTINE Glue_GetOP +!---------------------------------------------------------------------------------------------------------------------------------- + +!> This routine forms the Jacobian for the glue-code input-output solves. +SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & + IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdu(:,:) !< Partial derivatives of input-output equations (U(y,u)=0) with respect + !! to the inputs (u) + REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdy(:,:) !< Partial derivatives of input-output equations (U(y,u)=0) with respect + !! to the outputs (y) + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + + ! local variables + INTEGER(IntKi) :: ThisModule ! Module ID + INTEGER(IntKi) :: i, j, k ! loop counter + INTEGER(IntKi) :: r_start, r_end ! row start/end of glue matrix + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'Glue_Jacobians' + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Note: Where the same Linearize_*_to_*() routines for mesh mapping are used in both dUdu and dUdy, the dUdy routines assume dUdu + ! has already called the routine (and so avoids calling the routines a second time). This means the dUdu routines must be called first. + + !..................................... + ! dUdu + !> \f$ \frac{\partial U_\Lambda}{\partial u} = + !! \begin{bmatrix} \frac{\partial U_\Lambda^{IfW}}{\partial u^{IfW}} & \frac{\partial U_\Lambda^{IfW}}{\partial u^{SrvD}} & + !! \frac{\partial U_\Lambda^{IfW}}{\partial u^{ED}} & \frac{\partial U_\Lambda^{IfW}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{IfW}}{\partial u^{AD}} \\ + !! \frac{\partial U_\Lambda^{SrvD}}{\partial u^{IfW}} & \frac{\partial U_\Lambda^{SrvD}}{\partial u^{SrvD}} & + !! \frac{\partial U_\Lambda^{SrvD}}{\partial u^{ED}} & \frac{\partial U_\Lambda^{SrvD}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{SrvD}}{\partial u^{AD}} \\ + !! \frac{\partial U_\Lambda^{ED}}{\partial u^{IfW}} & \frac{\partial U_\Lambda^{ED}}{\partial u^{SrvD}} & + !! \frac{\partial U_\Lambda^{ED}}{\partial u^{ED}} & \frac{\partial U_\Lambda^{ED}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{ED}}{\partial u^{AD}} \\ + !! \frac{\partial U_\Lambda^{BD}}{\partial u^{IfW}} & \frac{\partial U_\Lambda^{BD}}{\partial u^{SrvD}} & + !! \frac{\partial U_\Lambda^{BD}}{\partial u^{ED}} & \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{BD}}{\partial u^{AD}} \\ + !! \frac{\partial U_\Lambda^{AD}}{\partial u^{IfW}} & \frac{\partial U_\Lambda^{AD}}{\partial u^{SrvD}} & + !! \frac{\partial U_\Lambda^{AD}}{\partial u^{ED}} & \frac{\partial U_\Lambda^{AD}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \\ + !! \end{bmatrix} = + !! \begin{bmatrix} I & 0 & 0 & 0 & \frac{\partial U_\Lambda^{IfW}}{\partial u^{AD}} \\ + !! 0 & I & 0 & 0 & 0 \\ + !! 0 & 0 & I & \frac{\partial U_\Lambda^{ED}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{ED}}{\partial u^{AD}} \\ + !! 0 & 0 & 0 & \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} & \frac{\partial U_\Lambda^{BD}}{\partial u^{AD}} \\ + !! 0 & 0 & 0 & 0 & \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \\ + !! \end{bmatrix} \f$ + !..................................... +! LIN-TODO: Add doc strings for new modules: SrvD & HD & MAP & SD + + if (.not. allocated(dUdu)) then + call AllocAry(dUdu, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'dUdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + dUdu = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below + + + !............ + ! \f$ \frac{\partial U_\Lambda^{IfW}}{\partial u^{IfW}} = I \f$ \n + ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial u^{SrvD}} = I \f$ \n + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{ED}} = I \f$ \n + ! Note that we're also doing \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} = I \f$ and + ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} = I \f$ here; We will add values to the off=diagonal terms of those block matrices later. + !............ + do j = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder(j) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + r_start = y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx(LIN_INPUT_COL) + r_end = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin( LIN_INPUT_COL) - 1 + do i = r_start,r_end + dUdu(i,i) = 1.0_R8Ki + end do + end do + end do + + + !............ + ! \f$ \frac{\partial U_\Lambda^{IfW}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 1=IfW) + !............ + IF (p_FAST%CompInflow == MODULE_IfW .and. p_FAST%CompAero == MODULE_AD) THEN + call Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, AD%Input(1), dUdu ) + end if ! we're using the InflowWind module + + !............ + ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial u^{SrvD}} \end{bmatrix} = \f$ (dUdu block row 2=SrvD) + !............ + if (p_FAST%CompServo == MODULE_SrvD) then + call Linear_SrvD_InputSolve_du( p_FAST, y_FAST, SrvD%p, SrvD%Input(1), ED%y, BD, SD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + !............ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{SrvD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{BD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{AD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{HD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{SD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{MAP}} \end{bmatrix} = \f$ (dUdu block row 3=ED) + !............ + ! we need to do this for CompElast=ED and CompElast=BD + + call Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !............ + ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 4=BD) + !............ + IF (p_FAST%CompElast == Module_BD) THEN + call Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF + + !............ + ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) + !............ + IF (p_FAST%CompAero == MODULE_AD) THEN + call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + + + !............ + ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial u^{HD}} \end{bmatrix} = \f$ (dUdu block row 6=HD) + !............ + IF (p_FAST%CompHydro == MODULE_HD) THEN + call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%y, SD%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + !............ + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial u^{HD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial u^{SD}} \end{bmatrix} = \f$ and + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial u^{MAP}} \end{bmatrix} = \f$ (dUdu block row 7=SD) + !............ + IF (p_FAST%CompSub == MODULE_SD) THEN + call Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO') + ENDIF + + !............ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial u^{MD}} \end{bmatrix} = \f$ (dUdu block row 9=MD) <<<< + !............ + if (p_FAST%CompMooring == MODULE_MD) then + call Linear_MD_InputSolve_du( p_FAST, y_FAST, MD%Input(1), ED%y, SD%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + ! LIN-TODO: Update the doc lines below to include SrvD, HD, SD, and MAP + !..................................... + ! dUdy + !> \f$ \frac{\partial U_\Lambda}{\partial y} = + !! \begin{bmatrix} \frac{\partial U_\Lambda^{IfW} }{\partial y^{IfW}} & \frac{\partial U_\Lambda^{IfW} }{\partial y^{SrvD}} & + !! \frac{\partial U_\Lambda^{IfW} }{\partial y^{ED} } & \frac{\partial U_\Lambda^{IfW} }{\partial y^{BD} } & \frac{\partial U_\Lambda^{IfW} }{\partial y^{AD}} \\ + !! \frac{\partial U_\Lambda^{SrvD}}{\partial y^{IfW}} & \frac{\partial U_\Lambda^{SrvD}}{\partial y^{SrvD}} & + !! \frac{\partial U_\Lambda^{SrvD}}{\partial y^{ED} } & \frac{\partial U_\Lambda^{SrvD}}{\partial y^{BD} } & \frac{\partial U_\Lambda^{SrvD}}{\partial y^{AD}} \\ + !! \frac{\partial U_\Lambda^{ED} }{\partial y^{IfW}} & \frac{\partial U_\Lambda^{ED} }{\partial y^{SrvD}} & + !! \frac{\partial U_\Lambda^{ED} }{\partial y^{ED} } & \frac{\partial U_\Lambda^{ED} }{\partial y^{BD} } & \frac{\partial U_\Lambda^{ED} }{\partial y^{AD}} \\ + !! \frac{\partial U_\Lambda^{BD} }{\partial y^{IfW}} & \frac{\partial U_\Lambda^{BD} }{\partial y^{SrvD}} & + !! \frac{\partial U_\Lambda^{BD} }{\partial y^{ED} } & \frac{\partial U_\Lambda^{BD} }{\partial y^{BD} } & \frac{\partial U_\Lambda^{BD} }{\partial y^{AD}} \\ + !! \frac{\partial U_\Lambda^{AD} }{\partial y^{IfW}} & \frac{\partial U_\Lambda^{AD} }{\partial y^{SrvD}} & + !! \frac{\partial U_\Lambda^{AD} }{\partial y^{ED} } & \frac{\partial U_\Lambda^{AD} }{\partial y^{BD} } & \frac{\partial U_\Lambda^{AD} }{\partial y^{AD}} \\ + !! \end{bmatrix} = + !! \begin{bmatrix} 0 & 0 & 0 & 0 & 0 \\ + !! 0 & 0 & \frac{\partial U_\Lambda^{SrvD}}{\partial y^{ED}} & 0 & 0 \\ + !! 0 & \frac{\partial U_\Lambda^{ED}}{\partial y^{SrvD}} & \frac{\partial U_\Lambda^{ED}}{\partial y^{ED}} & \frac{\partial U_\Lambda^{ED}}{\partial y^{BD}} & \frac{\partial U_\Lambda^{ED}}{\partial y^{AD}} \\ + !! 0 & 0 & \frac{\partial U_\Lambda^{BD}}{\partial y^{ED}} & \frac{\partial U_\Lambda^{BD}}{\partial y^{BD}} & \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \\ + !! \frac{\partial U_\Lambda^{AD}}{\partial y^{IfW}} & 0 & \frac{\partial U_\Lambda^{AD}}{\partial y^{ED}} & \frac{\partial U_\Lambda^{AD}}{\partial y^{BD}} & 0 \\ + !! \end{bmatrix} \f$ + !..................................... + if (.not. allocated(dUdy)) then + call AllocAry(dUdy, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dUdy', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + dUdy = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below + + !............ + ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 2=SrvD) + !............ + if (p_FAST%CompServo == MODULE_SrvD) then ! need to do this regardless of CompElast + call Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, SrvD%p, SrvD%Input(1), ED%y, BD, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + + !............ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{SrvD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{BD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{AD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{HD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{SD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 3=ED) + !............ + + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !............ + ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{BD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 4=BD) + !............ + if (p_FAST%CompElast == MODULE_BD) then + call Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + !............ + ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial y^{IfW}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial y^{BD}} \end{bmatrix} = \f$ (dUdy block row 5=AD) + !............ + if (p_FAST%CompAero == MODULE_AD) then ! need to do this regardless of CompElast + + if (p_FAST%CompInflow == MODULE_IfW) then + call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%Input(1), dUdy ) + end if + + call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + end if + + + !............ + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{HD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{SD}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 7=SD) + !............ + if (p_FAST%CompHydro == MODULE_HD) then + call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + !LIN-TODO: Add doc strings and look at above doc string + IF (p_FAST%CompSub == Module_SD) THEN + call Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN + write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO' + ENDIF + + !............ + ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{SD}} \end{bmatrix} = \f$ (dUdy block row 8=MAP) + !............ + if (p_FAST%CompMooring == MODULE_MAP) then + call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + !............ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial y^{SD}} \end{bmatrix} = \f$ (dUdy block row 9=MD) <<<< + !............ + if (p_FAST%CompMooring == MODULE_MD) then + call Linear_MD_InputSolve_dy( p_FAST, y_FAST, MD%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + +END SUBROUTINE Glue_Jacobians + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{IfW}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect IfW inputs?) +SUBROUTINE Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, u_AD, dUdu ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output data (for linearization) + TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(IfW)/du^(AD) block + + + INTEGER(IntKi) :: i, j, k ! loop counters + INTEGER(IntKi) :: i2, j2 ! loop counters + INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located + INTEGER(IntKi) :: Node ! InflowWind node number + + + ! compare with IfW_InputSolve(): + + Node = 0 !InflowWind node + if (p_FAST%CompServo == MODULE_SrvD) Node = Node + 1 + + IF (p_FAST%CompAero == MODULE_AD) THEN + + ! blades: + AD_Start_Bl = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) & + + u_AD%rotors(1)%TowerMotion%NNodes * 9 & ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components + + u_AD%rotors(1)%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components + + do k = 1,size(u_AD%rotors(1)%BladeRootMotion) + AD_Start_Bl = AD_Start_Bl + u_AD%rotors(1)%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components + end do + ! next is u_AD%BladeMotion(k): + + DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) + DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes + Node = Node + 1 ! InflowWind node + do i=1,3 !XYZ components of this node + i2 = y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (Node-1)*3 + i - 1 + j2 = AD_Start_Bl + (j-1)*3 + i - 1 + dUdu( i2, j2 ) = -1.0_R8Ki + end do + END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements + + ! get starting AD index of BladeMotion for next blade + AD_Start_Bl = AD_Start_Bl + u_AD%rotors(1)%BladeMotion(k)%Nnodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components + END DO !K = 1,p%NumBl + + ! tower: + DO J=1,u_AD%rotors(1)%TowerMotion%nnodes + Node = Node + 1 + do i=1,3 !XYZ components of this node + i2 = y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (Node-1)*3 + i - 1 + j2 = y_FAST%Lin%Modules(MODULE_AD )%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (j-1)*3 + i - 1 + dUdu( i2, j2 ) = -1.0_R8Ki + end do + END DO + + ! HubPosition and HubOrientation from ElastoDyn are missing from this + END IF +END SUBROUTINE Linear_IfW_InputSolve_du_AD + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{ED}/du^{BD} and dU^{ED}/du^{AD} blocks (ED row) of dUdu. (i.e., how do changes in the AD and BD inputs affect the ED inputs?) +SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: j ! Loops through StC instances + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: SrvD_Start ! starting index of dUdu (column) where SrvD StC load is + INTEGER(IntKi) :: BD_Start ! starting index of dUdu (column) where BD root motion inputs are located + INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located + INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located + INTEGER(IntKi) :: HD_Start ! starting index of dUdu (column) where HD motion inputs are located + INTEGER(IntKi) :: SD_Start ! starting index of dUdu (column) where SD TP motion inputs are located + INTEGER(IntKi) :: MAP_Start ! starting index of dUdu (column) where MAP fairlead motion inputs are located + INTEGER(IntKi) :: MD_Start ! starting index of dUdu (column) where MD fairlead motion inputs are located + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_du' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + !.......... + ! dU^{ED}/du^{SrvD} + !.......... + if (p_FAST%CompServo == MODULE_SrvD) then + ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + !-------------------- + ! Blade (BD or ED) + if ( p_FAST%CompElast == Module_ED ) then + if ( allocated(SrvD%y%BStCLoadMesh) ) then + do j=1,size(SrvD%y%BStCLoadMesh,2) + do K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + if (SrvD%y%BStCLoadMesh(K,j)%Committed) then + CALL Linearize_Point_to_Point( SrvD%y%BStCLoadMesh(k,j), u_ED%BladePtLoads(k), MeshMapData%BStC_P_2_ED_P_B(k,j), ErrStat2, ErrMsg2, SrvD%Input(1)%BStCMotionMesh(k,j), y_ED%BladeLn2Mesh(k) ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! 3 forces at each node (we're going to start at the moments since the M_us matrix is for moments...) + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_BStC_u(1,k,j) + ! SrvD is source in the mapping, so we want M_{uSm} (moments) + if (allocated(MeshMapData%BStC_P_2_ED_P_B(k,j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%BStC_P_2_ED_P_B(k,j)%dM%m_us, ED_Start_mt, SrvD_Start ) + end if + ! get starting index of next blade + ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes* 3 + endif + enddo + enddo + endif + endif + !-------------------- + ! Nacelle (ED only) + if ( allocated(SrvD%y%NStCLoadMesh) ) then + do j = 1,size(SrvD%y%NStCLoadMesh) + if (SrvD%y%NStCLoadMesh(j)%Committed) then + call Linearize_Point_to_Point( SrvD%y%NStCLoadMesh(j), u_ED%NacelleLoads, MeshMapData%NStC_P_2_ED_P_N(j), ErrStat2, ErrMsg2, SrvD%Input(1)%NStCMotionMesh(j), y_ED%NacelleMotion ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ED_Start_mt = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) & + + u_ED%NacelleLoads%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_NStC_u(1,j) + ! SrvD is source in the mapping, so we want M_{uSm} (moments) + if (allocated(MeshMapData%NStC_P_2_ED_P_N(j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%NStC_P_2_ED_P_N(j)%dM%m_us, ED_Start_mt, SrvD_Start ) + end if + endif + enddo + endif + !-------------------- + ! Tower (ED only) + if ( allocated(SrvD%y%TStCLoadMesh) ) then + do j = 1,size(SrvD%y%TStCLoadMesh) + if (SrvD%y%TStCLoadMesh(j)%Committed) then + call Linearize_Point_to_Point( SrvD%y%TStCLoadMesh(j), u_ED%TowerPtLoads, MeshMapData%TStC_P_2_ED_P_T(j), ErrStat2, ErrMsg2, SrvD%Input(1)%TStCMotionMesh(j), y_ED%TowerLn2Mesh ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & + + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_TStC_u(1,j) + ! SrvD is source in the mapping, so we want M_{uSm} (moments) + if (allocated(MeshMapData%TStC_P_2_ED_P_T(j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%TStC_P_2_ED_P_T(j)%dM%m_us, ED_Start_mt, SrvD_Start ) + endif + endif + enddo + endif + !-------------------- + ! Substructure (SD or ED) + if (p_FAST%CompSub /= MODULE_SD) then + if ( allocated(SrvD%y%SStCLoadMesh) ) then + do j=1,size(SrvD%y%SStCLoadMesh) + if (SrvD%y%SStCLoadMesh(j)%Committed) then + call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_ED%PlatformPtMesh ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_u(1,j) + ! SrvD is source in the mapping, so we want M_{uSm} (moments) + if (allocated(MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us, ED_Start_mt, SrvD_Start ) + endif + endif + enddo + endif + endif + endif + + + !.......... + ! dU^{ED}/du^{AD} + !.......... + IF ( p_FAST%CompAero == Module_AD ) THEN + + ! ED inputs on blade from AeroDyn + IF (p_FAST%CompElast == Module_ED) THEN + + ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade + AD_Start_Bl = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) + + CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start_Bl ) + end if + + ! get starting index of next blade + ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes* 3 ! skip the moments on this blade + + END DO + + END IF + + ! ED inputs on tower from AD: + + IF ( y_AD%rotors(1)%TowerLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & + + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + + CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_ED_P_T%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_ED_P_T%dM%m_us, ED_Start_mt, y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + END IF + + END IF + + + !.......... + ! dU^{ED}/du^{BD} + !.......... + + IF ( p_FAST%CompElast == Module_BD ) THEN ! see routine U_ED_SD_HD_BD_Orca_Residual() in SolveOption1 + ED_Start_mt = Indx_u_ED_Hub_Start(u_ED, y_FAST) & + + u_ED%HubPtLoad%NNodes * 3 ! 3 forces at the hub (so we start at the moments) + + ! Transfer BD loads to ED hub input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + do k=1,p_FAST%nBeams + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) + + CALL Linearize_Point_to_Point( BD%y(k)%ReactionForce, u_ED%HubPtLoad, MeshMapData%BD_P_2_ED_P(k), ErrStat2, ErrMsg2, BD%Input(1,k)%RootMotion, y_ED%HubPtMotion) !u_BD%RootMotion and y_ED%HubPtMotion contain the displaced positions for load calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! BD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%BD_P_2_ED_P(k)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%BD_P_2_ED_P(k)%dM%m_us, ED_Start_mt, BD_Start ) + end if + + end do ! k + + END IF + + ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + + if ( p_FAST%CompSub == Module_SD ) then + !.......... + ! dU^{ED}/du^{SD} + !.......... + ! Transfer SD load outputs to ED PlatformPtMesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + SD_Start = Indx_u_SD_TPMesh_Start(SD%Input(1), y_FAST) + + call Linearize_Point_to_Point( SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, SD%Input(1)%TPMesh, y_ED%PlatformPtMesh) !SD%Input(1)%TPMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%SD_TP_2_ED_P%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%SD_TP_2_ED_P%dM%m_us, ED_Start_mt, SD_Start ) + end if + + else if ( p_FAST%CompSub == Module_None ) then + !.......... + ! dU^{ED}/du^{HD} + !.......... + + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn} + + ! we're just going to assume u_ED%PlatformPtMesh is committed + if ( HD%y%Morison%Mesh%Committed ) then ! meshes for floating + + + ! Transfer HD load outputs to ED PlatformPtMesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + HD_Start = Indx_u_HD_Morison_Start(HD%Input(1), y_FAST) + + call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%HD_M_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_M_P_2_SubStructure%dM%m_us, ED_Start_mt, HD_Start ) + end if + + end if + if ( HD%y%WAMITMesh%Committed ) then ! meshes for floating + + ! Transfer HD load outputs to ED PlatformPtMesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + HD_Start = Indx_u_HD_WAMIT_Start(HD%Input(1), y_FAST) + + call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%HD_W_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_SubStructure%dM%m_us, ED_Start_mt, HD_Start ) + end if + + end if + end if + + !.......... + ! dU^{ED}/du^{MAP} + !.......... + + if ( p_FAST%CompMooring == Module_MAP ) then + + ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + + ! Transfer MAP loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one MAP Fairlead point + + CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! MAP is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, ED_Start_mt, MAP_Start ) + end if + + !.......... + ! dU^{ED}/du^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + + ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + + ! Transfer MD loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MD_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one coupled MD object + + CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_ED%PlatformPtMesh) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, ED_Start_mt, MD_Start ) + end if + + end if + + end if +END SUBROUTINE Linear_ED_InputSolve_du + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{SD}/du^{SrvD}, dU^{SD}/du^{HD}, dU^{SD}/du^{SD}, and dU^{SD}/du^{MAP} blocks (SD row) of dUdu. (i.e., how do changes in SrvD, HD, SD, and MAP inputs affect the SD inputs?) +SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(SD_InputType), INTENT(INOUT) :: u_SD !< SD Inputs at t + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(SD)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: j, SrvD_Start + INTEGER(IntKi) :: HD_Start + INTEGER(IntKi) :: MAP_Start, MD_Start + INTEGER(IntKi) :: SD_Start, SD_Start_td, SD_Start_tr + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_SD_InputSolve_du' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( p_FAST%CompSub == Module_SD ) THEN ! see routine U_ED_SD_HD_BD_Orca_Residual() in SolveOption1 + + + !.......... + ! dU^{SD}/du^{SrvD} + !.......... + if (p_FAST%CompServo == MODULE_SrvD) then + !-------------------- + ! Substructure (SD or ED) + if ( allocated(SrvD%y%SStCLoadMesh) ) then + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) & + + u_SD%LMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + do j=1,size(SrvD%y%SStCLoadMesh) + if (SrvD%y%SStCLoadMesh(j)%Committed) then + call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_SD%LMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_SD%Y3Mesh ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_u(1,j) + ! SrvD is source in the mapping, so we want M_{uSm} (moments) + if (allocated(MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us, SD_Start, SrvD_Start ) + endif + endif + enddo + endif + endif + + + !.......... + ! dU^{SD}/du^{SD} + !.......... + + call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + + SD_Start_td = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + SD_Start_tr = SD_Start_td + u_SD%TPMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_SD_TP%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_SD_TP%dM%tv_ud, SD_Start_tr, SD_Start_td ) + end if + + ! translational acceleration: + SD_Start_tr = SD_Start_tr + u_SD%TPMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%ED_P_2_SD_TP%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_SD_TP%dM%ta_ud, SD_Start_tr, SD_Start_td ) + end if + + + + !.......... + ! dU^{SD}/du^{HD} + !.......... + + ! we're just going to assume u_SD%LMesh is committed + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) & + + u_SD%LMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} + + + ! Transfer HD load outputs to SD LMesh input: + if ( HD%y%Morison%Mesh%Committed ) then ! meshes for floating + + ! dU^{SD}/du^{HD} + + ! we're mapping loads, so we also need the sibling meshes' displacements: + HD_Start = Indx_u_HD_Morison_Start(HD%Input(1), y_FAST) + + call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_SD%Y2Mesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%HD_M_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_M_P_2_SubStructure%dM%m_us, SD_Start, HD_Start ) + end if + + + + + end if + if ( HD%y%WAMITMesh%Committed ) then ! meshes for floating + + ! Transfer HD load outputs to ED PlatformPtMesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + HD_Start = Indx_u_HD_WAMIT_Start(HD%Input(1), y_FAST) + + call Linearize_Point_to_Point( HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_SD%Y2Mesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%HD_W_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_SubStructure%dM%m_us, SD_Start, HD_Start ) + end if + + + end if + end if + + !.......... + ! dU^{SD}/du^{MAP} + !.......... + + if ( p_FAST%CompMooring == Module_MAP ) then + + ! Transfer MAP loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one MAP Fairlead point + + CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_SD%Y3Mesh contain the displaced positions for load calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, SD_Start, MAP_Start ) + end if + + !.......... + ! dU^{SD}/du^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + + ! Transfer MD loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MD_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one coupled MD object + + CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_SD%Y3Mesh) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, SD_Start, MD_Start ) + end if + + end if + + END IF +END SUBROUTINE Linear_SD_InputSolve_du + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{SD}/dy^{SrvD}, dU^{SD}/dy^{HD} and dU^{SD}/dy^{SD} blocks (SD row) of dUdu. (i.e., how do changes in SrvD, HD, and SD inputs affect the SD inputs?) +SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(SD_InputType), INTENT(INOUT) :: u_SD !< SD Inputs at t + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(SD)/dy^(SD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: j, SrvD_Out_Start, SD_Start, SD_Out_Start, HD_Start, HD_Out_Start, ED_Out_Start, MAP_Out_Start, MD_Out_Start + INTEGER(IntKi) :: MAP_Start, MD_Start +! INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation +! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_SD_InputSolve_du' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + if ( p_FAST%CompSub /= Module_SD ) return + + !.......... + ! dU^{SD}/dy^{SrvD} + !.......... + if (p_FAST%CompServo == MODULE_SrvD) then + !-------------------- + ! Substructure (SD or ED) + if ( allocated(SrvD%y%SStCLoadMesh) ) then + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%Force field + do j=1,size(SrvD%y%SStCLoadMesh) + if (SrvD%y%SStCLoadMesh(j)%Committed) then + SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_y(1,j) + call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_SD%LMesh, MeshMapData%SStC_P_P_2_SubStructure(j), SD_Start, SrvD_Out_Start, dUdy) + endif + enddo + endif + endif + + !.......... + ! dU^{SD}/dy^{ED} + !.......... + + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + + SD_Start = Indx_u_SD_TPMesh_Start(u_SD, y_FAST) ! start of u_SD%MTPMesh%TranslationDisp field + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, SD_Start, ED_Out_Start, dUdy, .false.) + + !.......... + ! dU^{SD}/dy^{HD} + !.......... + ! HD + ! parts of dU^{SD}/dy^{HD} and dU^{SD}/dy^{SD}: + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-SubDyn + SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y2Mesh%TranslationDisp field + ! we're just going to assume u_SD%LMesh is committed + if ( HD%y%Morison%Mesh%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_SD%Y2Mesh) + HD_Out_Start = Indx_y_HD_Morison_Start(HD%y, y_FAST) + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%Force field + call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SubStructure, SD_Start, HD_Out_Start, dUdy) + + ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_SD%LMesh%Moment field (skip the SD forces) + call SetBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, SD_Start, SD_Out_Start ) +! maybe this should be SumBlockMatrix with future changes to linearized modules??? + end if + if ( HD%y%WAMITMesh%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_SD%Y2Mesh) + HD_Out_Start = Indx_y_HD_WAMIT_Start(HD%y, y_FAST) + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%Force field + call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SubStructure, SD_Start, HD_Out_Start, dUdy) + + ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_SD%LMesh%Moment field (skip the SD forces) + call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_SubStructure%dM%m_uD, SD_Start, SD_Out_Start ) +! maybe this should be SumBlockMatrix with future changes to linearized modules??? + end if + end if + + !.......... + ! dU^{SD}/dy^{MAP} + !.......... + if ( p_FAST%CompMooring == Module_MAP ) then + if ( MAPp%y%ptFairleadLoad%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%Y3Mesh contain the displaced positions for load calculations + MAP_Out_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%TranslationDisp field + call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_SD%LMesh, MeshMapData%Mooring_2_Structure, SD_Start, MAP_Out_Start, dUdy) + + ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_ED%LMesh%Moment field (skip the SD forces) + SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, SD_Start, SD_Out_Start ) + end if + + !.......... + ! dU^{SD}/dy^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + if ( MD%y%CoupledLoads(1)%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + MD_Out_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%TranslationDisp field + call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_2_Structure, SD_Start, MD_Out_Start, dUdy) + + ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_ED%LMesh%Moment field (skip the SD forces) + SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, SD_Start, SD_Out_Start ) + end if + end if +END SUBROUTINE Linear_SD_InputSolve_dy + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs +!! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. +SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: j ! Loops through StC instances + INTEGER(IntKi) :: k ! Loops through blades + INTEGER(IntKi) :: SrvD_Start ! starting index of dUdu (row) where BD inputs are located + INTEGER(IntKi) :: BD_Start ! starting index of dUdu (row) where BD inputs are located + INTEGER(IntKi) :: AD_Start ! starting index of dUdu (column) where AD inputs are located + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_BD_InputSolve_du' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + !.......... + ! dU^{BD}/du^{SrvD} + !.......... + if (p_FAST%CompServo == MODULE_SrvD) then + !-------------------- + ! Blade (BD or ED) + if ( allocated(SrvD%y%BStCLoadMesh) ) then + do j=1,size(SrvD%y%BStCLoadMesh,2) + do K = 1,p_FAST%nBeams ! Loop through all blades + if (SrvD%y%BStCLoadMesh(K,j)%Committed) then + CALL Linearize_Point_to_Line2( SrvD%y%BStCLoadMesh(k,j), BD%Input(1,k)%DistrLoad, MeshMapData%BStC_P_2_BD_P_B(k,j), ErrStat2, ErrMsg2, SrvD%Input(1)%BStCMotionMesh(k,j), BD%y(k)%BldMotion ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & + + BD%Input(1,k)%RootMotion%NNodes *18 & ! displacement, rotation, & acceleration fields for each node + + BD%Input(1,k)%PointLoad%NNodes * 6 & ! force + moment fields for each node + + BD%Input(1,k)%DistrLoad%NNodes * 3 ! force field for each node (start with moment field) + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_BStC_u(1,k,j) + ! SrvD is source in the mapping, so we want M_{uSm} (moments) + if (allocated(MeshMapData%BStC_P_2_BD_P_B(k,j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%BStC_P_2_BD_P_B(k,j)%dM%m_us, BD_Start, SrvD_Start ) + end if + endif + enddo + enddo + endif + endif + + !.......... + ! dU^{BD}/du^{AD} + !.......... + IF ( p_FAST%CompAero == Module_AD ) THEN + + ! BD inputs on blade from AeroDyn + + + if (p_FAST%BD_OutputSibling) then + + DO K = 1,p_FAST%nBeams ! Loop through all blades + CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + else + + DO K = 1,p_FAST%nBeams ! Loop through all blades + !linearization for dUdy will need some matrix multiplies because of the transfer (chain rule!), but we will perform individual linearization calculations here + !!! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: + CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + end if + + + DO K = 1,p_FAST%nBeams ! Loop through all blades + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then + AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for the start of u_AD%BladeMotion(k)%translationDisp field + + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & + + BD%Input(1,k)%RootMotion%NNodes *18 & ! displacement, rotation, & acceleration fields for each node + + BD%Input(1,k)%PointLoad%NNodes * 6 & ! force + moment fields for each node + + BD%Input(1,k)%DistrLoad%NNodes * 3 ! force field for each node (start with moment field) + + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, BD_Start, AD_Start ) + end if + + END DO + + END IF + + !.......... + ! dU^{BD}/du^{BD} + ! note that the 1s on the diagonal have already been set, so we will fill in the off diagonal terms. + !.......... + + !IF ( p_FAST%CompElast == Module_BD ) THEN ! see routine U_ED_SD_HD_BD_Orca_Residual() in SolveOption1 + + ! Transfer ED motions to BD motion input (BD inputs depend on previously calculated BD inputs from ED): + do k=1,p_FAST%nBeams + + call Linearize_Point_to_Point( y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_BD_P(k)%dM%tv_uD )) then + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) + BD%Input(1,k)%RootMotion%NNodes * 6 ! skip root translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_BD_P(k)%dM%tv_uD, BD_Start, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%ED_P_2_BD_P(k)%dM%ta_uD )) then + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) + BD%Input(1,k)%RootMotion%NNodes * 12 ! skip root translational displacement, orientation, and velocity (translation and rotation) fields + + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_BD_P(k)%dM%ta_uD, BD_Start, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ) + end if + + end do ! k + + !END IF + +END SUBROUTINE Linear_BD_InputSolve_du +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) +SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Start_td ! starting index of dUdu (column) where AD translation displacements are located + INTEGER(IntKi) :: AD_Start_tv ! starting index of dUdu (column) where AD translation velocities are located + INTEGER(IntKi) :: AD_Start_ta ! starting index of dUdu (column) where AD translation accelerations are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_AD_InputSolve_du' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine + + ! look at how the translational displacement gets transfered to the translational velocity: + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn and/or BeamDyn: + !------------------------------------------------------------------------------------------------- + + ! tower + IF (u_AD%rotors(1)%TowerMotion%Committed) THEN + + CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + + + !AD is the destination here, so we need tv_ud + if (allocated( MeshMapData%ED_L_2_AD_L_T%dM%tv_ud)) then + AD_Start_td = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_AD_L_T%dM%tv_ud, AD_Start_tv, AD_Start_td ) + end if + + + END IF + + + ! blades + IF (p_FAST%CompElast == Module_ED ) THEN + + DO k=1,size(u_AD%rotors(1)%BladeMotion) + CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + ELSEIF (p_FAST%CompElast == Module_BD ) THEN + + DO k=1,size(u_AD%rotors(1)%BladeMotion) + CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + END IF + + + + DO k=1,size(u_AD%rotors(1)%BladeMotion) + AD_Start_td = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for u_AD%BladeMotion(k)%translationDisp field + + !AD is the destination here, so we need tv_ud + if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then + ! index for u_AD%BladeMotion(k+1)%translationVel field + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) + end if + + if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%ta_ud)) then + AD_Start_ta = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 12 ! 4 fields (TranslationDisp, Orientation, TranslationVel, and RotationVel) with 3 components before translational velocity field + + call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%ta_ud, AD_Start_ta, AD_Start_td ) + end if + + END DO +END SUBROUTINE Linear_AD_InputSolve_du + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{SrvD}/du^{SrvD} block (SrvD row) of dUdu. +!! (i.e., how do changes in the SrvD inputs affect the SrvD inputs?) +SUBROUTINE Linear_SrvD_InputSolve_du( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, SD, MeshMapData, dUdu, ErrStat, ErrMsg ) + type(FAST_ParameterType), intent(in ) :: p_FAST !< Glue-code simulation parameters + type(FAST_OutputFileType), intent(in ) :: y_FAST !< Glue-code output parameters (for linearization) + type(SrvD_ParameterType), intent(in ) :: p_SrvD !< SrvD parameters + type(SrvD_InputType), intent(inout) :: u_SrvD !< SrvD Inputs at t + type(ED_OutputType), intent(in ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + type(BeamDyn_Data), intent(in ) :: BD !< BD data at t + type(SubDyn_Data), intent(in ) :: SD !< SD data at t + type(FAST_ModuleMapType), intent(inout) :: MeshMapData !< Data for mapping between modules + real(R8Ki), intent(inout) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message + + ! local variables + integer(IntKi) :: i,j,k ! Generic counters + INTEGER(IntKi) :: SrvD_Start ! starting index of dUdu (column) where the StC motion inputs are located + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'Linear_SrvD_InputSolve_du' + + ! Initialize error status + ErrStat = ErrID_None + ErrMsg = "" + + !-------------------- + ! dU^{SrvD}/du^{SrvD} + !-------------------- + ! Blade StrucCtrl + if ( p_FAST%CompElast == Module_ED ) then + if ( ALLOCATED(u_SrvD%BStCMotionMesh) ) then + do j=1,size(u_SrvD%BStCMotionMesh,2) + do K = 1,size(y_ED%BladeLn2Mesh) + if (u_SrvD%BStCMotionMesh(K,j)%Committed) then + CALL Linearize_Line2_to_Point( y_ED%BladeLn2Mesh(K), u_SrvD%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%ED_L_2_BStC_P_B(K,j)%dM%tv_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j) + 6) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_BStC_P_B(K,j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%ED_L_2_BStC_P_B(K,j)%dM%ta_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j) + 12) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_BStC_P_B(K,j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + endif + enddo + enddo + endif + elseif ( p_FAST%CompElast == Module_BD ) then + if ( ALLOCATED(u_SrvD%BStCMotionMesh) ) then + do j=1,size(u_SrvD%BStCMotionMesh,2) + do K = 1,p_FAST%nBeams + if (u_SrvD%BStCMotionMesh(K,j)%Committed) then + CALL Linearize_Line2_to_Point( BD%y(k)%BldMotion, u_SrvD%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%BD_L_2_BStC_P_B(K,j)%dM%tv_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j) + 6) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%BD_L_2_BStC_P_B(K,j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%BD_L_2_BStC_P_B(K,j)%dM%ta_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j) + 12) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%BD_L_2_BStC_P_B(K,j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + endif + enddo + enddo + endif + endif + !-------------------- + ! Nacelle (ED only) + if ( ALLOCATED(u_SrvD%NStCMotionMesh) ) then + do j = 1,size(u_SrvD%NStCMotionMesh) + if (u_SrvD%NStCMotionMesh(j)%Committed) then + call Linearize_Point_to_Point( y_ED%NacelleMotion, u_SrvD%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_NStC_P_N(j)%dM%tv_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_NStC_u(1,j) + 6) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_NStC_P_N(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%ED_P_2_NStC_P_N(j)%dM%ta_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_NStC_u(1,j) + 12) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_NStC_P_N(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + endif + enddo + endif + !-------------------- + ! Tower + if ( ALLOCATED(u_SrvD%TStCMotionMesh) ) then + do j = 1,size(u_SrvD%TStCMotionMesh) + if (u_SrvD%TStCMotionMesh(j)%Committed) then + call Linearize_Line2_to_Point( y_ED%TowerLn2Mesh, u_SrvD%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%ED_L_2_TStC_P_T(j)%dM%tv_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_TStC_u(1,j) + 6) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_TStC_P_T(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%ED_L_2_TStC_P_T(j)%dM%ta_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_TStC_u(1,j) + 12) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_TStC_P_T(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + endif + enddo + endif + !-------------------- + ! Substructure (SD or ED) + if (p_FAST%CompSub /= MODULE_SD) then + if ( ALLOCATED(u_SrvD%SStCMotionMesh) ) then + do j=1,size(u_SrvD%SStCMotionMesh) + if (u_SrvD%SStCMotionMesh(j)%Committed) then + CALL Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%Substructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%Substructure_2_SStC_P_P(j)%dM%tv_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 6) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%Substructure_2_SStC_P_P(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%Substructure_2_SStC_P_P(j)%dM%ta_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 12) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%Substructure_2_SStC_P_P(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + endif + enddo + endif + else + if ( ALLOCATED(u_SrvD%SStCMotionMesh) ) then + do j=1,size(u_SrvD%SStCMotionMesh) + IF (u_SrvD%SStCMotionMesh(j)%Committed) then + CALL Linearize_Point_to_Point( SD%y%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! translational velocity: + if (allocated(MeshMapData%SubStructure_2_SStC_P_P(j)%dM%tv_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 6) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_SStC_P_P(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + + ! translational acceleration: + if (allocated(MeshMapData%SubStructure_2_SStC_P_P(j)%dM%ta_uD )) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 12) ! skip translational displacement and orientation fields + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_SStC_P_P(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + end if + endif + enddo + endif + endif +END SUBROUTINE Linear_SrvD_InputSolve_du + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{SrvD}/dy^{ED}, dU^{SrvD}/dy^{BD}, dU^{SrvD}/dy^{SD} block of dUdy. +!! (i.e., how do changes in the ED, SD, BD outputs affect the SrvD inputs?) +!! NOTE: Linearze_Point_to_Point routines done in Linear_SrvD_InputSolve_du +SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) +!.................................................................................................................................. + type(FAST_ParameterType), intent(in ) :: p_FAST !< Glue-code simulation parameters + type(FAST_OutputFileType), intent(in ) :: y_FAST !< Output variables for the glue code + type(SrvD_ParameterType), intent(in ) :: p_SrvD !< SrvD parameters (holds indices for jacobian entries for each StC) + type(SrvD_InputType), intent(inout) :: u_SrvD !< SrvD Inputs at t + type(ED_OutputType), intent(in ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + type(BeamDyn_Data), intent(in ) :: BD !< BeamDyn data + type(SD_OutputType), intent(in ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) + + type(FAST_ModuleMapType), intent(inout) :: MeshMapData !< Data for mapping between modules + real(R8Ki), intent(inout) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message + + integer(IntKi) :: i,j,k ! loop counters + integer(intKi) :: ED_Start_Yaw !< starting index of dUdy (column) where ED Yaw/YawRate/HSS_Spd outputs are located (just before WriteOutput) + integer(IntKi) :: SrvD_Start, ED_Out_Start, BD_Out_Start, SD_Out_Start + character(*), parameter :: RoutineName = 'Linear_SrvD_InputSolve_dy' + + ! Initialize error status + ErrStat = ErrID_None + ErrMsg = "" + + !-------------------- + ! dU^{SrvD}/dy^{ED} + !-------------------- + ED_Start_Yaw = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + do i=1,size(SrvD_Indx_Y_BlPitchCom) ! first 3 columns + dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + SrvD_Indx_Y_BlPitchCom(i) - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi + end do + + !---------------------------------------- + ! Structural controls + !---------------------------------------- + ! Blade + if ( p_FAST%CompElast == Module_ED ) then + !-------------------- + ! dU^{SrvD}/dy^{ED} + !-------------------- + if ( ALLOCATED(u_SrvD%BStCMotionMesh) ) then + do j=1,size(u_SrvD%BStCMotionMesh,2) + do K = 1,size(y_ED%BladeLn2Mesh) + if (u_SrvD%BStCMotionMesh(K,j)%Committed) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j)) + ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%BladeLn2Mesh(K), u_SrvD%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), SrvD_Start, ED_Out_Start, dUdy, .false.) + endif + enddo + enddo + endif + elseif ( p_FAST%CompElast == Module_BD ) then + !-------------------- + ! dU^{SrvD}/dy^{BD} + !-------------------- + if ( ALLOCATED(u_SrvD%BStCMotionMesh) ) then + do j=1,size(u_SrvD%BStCMotionMesh,2) + do K = 1,p_FAST%nBeams + if (u_SrvD%BStCMotionMesh(K,j)%Committed) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j)) + BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( BD%y(k)%BldMotion, u_SrvD%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), SrvD_Start, BD_Out_Start, dUdy, .false.) + endif + enddo + enddo + endif + endif + + !-------------------- + ! Nacelle -- dU^{SrvD}/dy^{ED} + !-------------------- + if ( ALLOCATED(u_SrvD%NStCMotionMesh) ) then + do j = 1,size(u_SrvD%NStCMotionMesh) + if (u_SrvD%NStCMotionMesh(j)%Committed) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_NStC_u(1,j)) + ED_Out_Start = Indx_y_ED_Nacelle_Start(y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%NacelleMotion, u_SrvD%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + endif + enddo + endif + + !-------------------- + ! Tower -- dU^{SrvD}/dy^{ED} + !-------------------- + if ( ALLOCATED(u_SrvD%TStCMotionMesh) ) then + do j = 1,size(u_SrvD%TStCMotionMesh) + if (u_SrvD%TStCMotionMesh(j)%Committed) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_TStC_u(1,j)) + ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%TowerLn2Mesh, u_SrvD%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + endif + enddo + endif + + !-------------------- + ! Substructure (SD or ED) + !-------------------- + if (p_FAST%CompSub /= MODULE_SD) then + !-------------------- + ! dU^{SrvD}/dy^{ED} + !-------------------- + if ( ALLOCATED(u_SrvD%SStCMotionMesh) ) then + do j=1,size(u_SrvD%SStCMotionMesh) + if (u_SrvD%SStCMotionMesh(j)%Committed) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j)) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%Substructure_2_SStC_P_P(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + endif + enddo + endif + else + !-------------------- + ! dU^{SrvD}/dy^{SD} + !-------------------- + if ( ALLOCATED(u_SrvD%SStCMotionMesh) ) then + do j=1,size(u_SrvD%SStCMotionMesh) + if (u_SrvD%SStCMotionMesh(j)%Committed) then + SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j)) + SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_SD%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), SrvD_Start, SD_Out_Start, dUdy, .false.) + endif + enddo + endif + endif +END SUBROUTINE Linear_SrvD_InputSolve_dy + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, dU^{ED}/dy^{AD}, dU^{ED}/dy^{HD}, and dU^{ED}/dy^{MAP} +!! blocks of dUdy. (i.e., how do changes in the SrvD, ED, BD, AD, HD, and MAP outputs effect the ED inputs?) +SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: i ! rows/columns + INTEGER(IntKi) :: j ! Loops through StC instance + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: SrvD_Out_Start ! starting index of dUdy (column) where the StC motion inputs are located + INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where particular BD fields are located + INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located + INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located + INTEGER(IntKi) :: HD_Out_Start ! starting index of dUdy (column) where HD output fields are located + INTEGER(IntKi) :: SD_Out_Start ! starting index of dUdy (column) where SD output fields are located + INTEGER(IntKi) :: MAP_Out_Start ! starting index of dUdy (column) where MAP output fields are located + INTEGER(IntKi) :: MD_Out_Start ! starting index of dUdy (column) where MoorDyn output fields are located + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + !.......... + ! dU^{ED}/dy^{SrvD} + ! ED inputs from ServoDyn outputs + !.......... + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + ! BlPitchCom, YawMom, GenTrq + ED_Start = Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) + do i=1,size(u_ED%BlPitchCom)+2 ! BlPitchCom, YawMom, GenTrq (NOT collective pitch) + dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi !SrvD_Indx_Y_BlPitchCom + end do + !-------------------- + ! Blade (BD or ED) + if ( p_FAST%CompElast == Module_ED ) then + if ( allocated(SrvD%y%BStCLoadMesh) ) then + do j=1,size(SrvD%y%BStCLoadMesh,2) + do K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + if (SrvD%y%BStCLoadMesh(K,j)%Committed) then + ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_BStC_y(1,k,j) + call Assemble_dUdy_Loads(SrvD%y%BStCLoadMesh(k,j), u_ED%BladePtLoads(k), MeshMapData%BStC_P_2_ED_P_B(k,j), ED_Start, SrvD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%BStC_P_2_ED_P_B(k,j)%dM%m_uD, ED_Start, ED_Out_Start ) + endif + enddo + enddo + endif + endif + !-------------------- + ! Nacelle (ED only) + if ( allocated(SrvD%y%NStCLoadMesh) ) then + do j = 1,size(SrvD%y%NStCLoadMesh) + if (SrvD%y%NStCLoadMesh(j)%Committed) then + ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_NStC_y(1,j) + call Assemble_dUdy_Loads(SrvD%y%NStCLoadMesh(j), u_ED%NacelleLoads, MeshMapData%NStC_P_2_ED_P_N(j), ED_Start, SrvD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Nacelle_Start(y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%NStC_P_2_ED_P_N(j)%dM%m_uD, ED_Start, ED_Out_Start ) + endif + enddo + endif + !-------------------- + ! Tower (ED only) + if ( allocated(SrvD%y%TStCLoadMesh) ) then + do j = 1,size(SrvD%y%TStCLoadMesh) + if (SrvD%y%TStCLoadMesh(j)%Committed) then + ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_TStC_y(1,j) + call Assemble_dUdy_Loads(SrvD%y%TStCLoadMesh(j), u_ED%TowerPtLoads, MeshMapData%TStC_P_2_ED_P_T(j), ED_Start, SrvD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%TStC_P_2_ED_P_T(j)%dM%m_uD, ED_Start, ED_Out_Start ) + endif + enddo + endif + !-------------------- + ! Substructure (SD or ED) + if (p_FAST%CompSub /= MODULE_SD) then + if ( allocated(SrvD%y%SStCLoadMesh) ) then + do j=1,size(SrvD%y%SStCLoadMesh) + if (SrvD%y%SStCLoadMesh(j)%Committed) then + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_y(1,j) + call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ED_Start, SrvD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) + endif + enddo + endif + endif + END IF + + ! parts of dU^{ED}/dy^{AD} and dU^{ED}/dy^{ED}: + + ! ElastoDyn inputs on blade from AeroDyn and ElastoDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + IF (p_FAST%CompElast == Module_ED) THEN + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_AD%rotors(1)%TowerLoad%NNodes * 6 ! start of y_AD%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !CALL Linearize_Line2_to_Point( y_AD%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) + + AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] + END DO + END IF ! ED + + + IF ( y_AD%rotors(1)%TowerLoad%Committed ) THEN + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !CALL Linearize_Line2_to_Point( y_AD%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%TowerMotion, y_ED%TowerLn2Mesh ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) ! u_ED%TowerPtLoads%Force field + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%Tower%Force + call Assemble_dUdy_Loads(y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_L_2_ED_P_T%dM%m_uD, ED_Start, ED_Out_Start ) + + END IF ! tower + + END IF ! aero loads + + ! U_ED_SD_HD_BD_Orca_Residual() in InputSolve Option 1 + IF (p_FAST%CompElast == Module_BD) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!DO k=1,p_FAST%nBeams + !!! CALL Linearize_Point_to_Point( BD%y(k)%ReactionForce, u_ED%HubPtLoad, MeshMapData%BD_P_2_ED_P(k), ErrStat2, ErrMsg2, BD%Input(1,k)%RootMotion, y_ED%HubPtMotion) + !!!END DO + + ! BD Reaction force-to-ED force transfer (dU^{ED}/dy^{BD}) from BD root-to-ED hub load transfer: + ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) ! start of u_ED%HubPtLoad%Force field + DO k=1,p_FAST%nBeams + BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! BD%y(k)%ReactionForce%Force field + call Assemble_dUdy_Loads(BD%y(k)%ReactionForce, u_ED%HubPtLoad, MeshMapData%BD_P_2_ED_P(k), ED_Start, BD_Out_Start, dUdy) + END DO + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}) from BD root-to-ED hub load transfer: + ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubPtLoad%Moment field (skip forces) + DO k=1,p_FAST%nBeams + ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%BD_P_2_ED_P(k)%dM%m_ud, ED_Start, ED_Out_Start) + END DO + + END IF + + if ( p_FAST%CompSub == Module_None ) then !This also occurs with ExtPtfm (though that's not linearized, yet) + ! HD + ! parts of dU^{ED}/dy^{HD} and dU^{ED}/dy^{ED}: + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + ! we're just going to assume u_ED%PlatformPtMesh is committed + if ( HD%y%Morison%Mesh%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! call Linearize_Point_to_Point( HD%y%Morison, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations + HD_Out_Start = Indx_y_HD_Morison_Start(HD%y, y_FAST) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ED_Start, HD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) + + end if + if ( HD%y%WAMITMesh%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + HD_Out_Start = Indx_y_HD_WAMIT_Start(HD%y, y_FAST) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ED_Start, HD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) + + end if + + + end if + + ! MAP + ! parts of dU^{ED}/dy^{MAP} and dU^{ED}/dy^{ED}: + if ( p_FAST%CompMooring == Module_MAP ) then + if ( MAPp%y%ptFairleadLoad%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations + MAP_Out_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ED_Start, MAP_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, ED_Start, ED_Out_Start ) + end if + ! MoorDyn + ! parts of dU^{ED}/dy^{MD} and dU^{ED}/dy^{ED}: + else if ( p_FAST%CompMooring == Module_MD ) then + if ( MD%y%CoupledLoads(1)%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + MD_Out_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ED_Start, MD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, ED_Start, ED_Out_Start ) + end if + end if + else if ( p_FAST%CompSub == Module_SD ) then + ! SubDyn + ! parts of dU^{ED}/dy^{SD} and dU^{ED}/dy^{ED}: + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + ! CALL Linearize_Point_to_Point( SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, SD%Input(1)%TPMesh, y_ED%PlatformPtMesh) !SD%Input(1)%TPMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Loads(SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ED_Start, SD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMapData%SD_TP_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + + !Mooring gets set in the Linear_SD_InputSolve_ routines + end if +END SUBROUTINE Linear_ED_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do +!! changes in the ED, BD, and AD outputs effect the BD inputs?) +SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: j ! Loops through StC instance + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: SrvD_Out_Start ! starting index of dUdy (column) where particular SrvD fields are located + INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: BD_Start ! starting index of dUdy (column) where particular BD fields are located + INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where BD output fields are located + INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki), ALLOCATABLE :: TempMat(:,:) ! temporary matrix for getting linearization matrices when BD input and output meshes are not siblings + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_BD_InputSolve_dy' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + !.......... + ! dU^{ED}/du^{SrvD} + !.......... + if (p_FAST%CompServo == MODULE_SrvD) then + !-------------------- + ! Blade (BD or ED) + if ( allocated(SrvD%y%BStCLoadMesh) ) then + do j=1,size(SrvD%y%BStCLoadMesh,2) + do K = 1,p_FAST%nBeams ! Loop through all blades + if (SrvD%y%BStCLoadMesh(K,j)%Committed) then + ! Start of DistrLoad nodes + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & + + BD%Input(1,k)%RootMotion%NNodes *18 & ! displacement, rotation, & acceleration fields for each node + + BD%Input(1,k)%PointLoad%NNodes * 6 ! force + moment fields for each node + SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_BStC_y(1,k,j) + call Assemble_dUdy_Loads(SrvD%y%BStCLoadMesh(k,j), BD%Input(1,k)%DistrLoad, MeshMapData%BStC_P_2_BD_P_B(k,j), BD_Start, SrvD_Out_Start, dUdy) + endif + enddo + enddo + endif + endif + + + ! parts of dU^{BD}/dy^{AD} and dU^{BD}/dy^{BD}: + + ! BeamDyn inputs on blade from AeroDyn and BeamDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_BD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!if (p_FAST%BD_OutputSibling) then + !!! CALL Linearize_Line2_to_Line2( y_AD%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), BD%y(k)%BldMotion ) + !!!else + !!! CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) + !!! CALL Linearize_Line2_to_Line2( y_AD%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + !!!end if + + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_AD%rotors(1)%TowerLoad%NNodes * 6 ! start of y_AD%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + DO K = 1,p_FAST%nBeams ! Loop through all blades + + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & ! start of BD%Input(1,k)%DistrLoad%Force field + + BD%Input(1,k)%RootMotion%NNodes *18 & ! displacement, rotation, & acceleration fields for each node + + BD%Input(1,k)%PointLoad%NNodes * 6 ! force + moment fields for each node + + ! AD loads-to-BD loads transfer (dU^{BD}/dy^{AD}): + call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), BD_Start, AD_Out_Start, dUdy) + AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%BladeLoad(k+1)%Force field [skip the moments to get to forces on next blade] + + + ! BD translation displacement-to-BD moment transfer (dU^{BD}/dy^{BD}): + BD_Start = BD_Start + BD%Input(1,k)%DistrLoad%NNodes * 3 ! start of BD%Input(1,k)%DistrLoad%Moment field (start with moment field) + BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) & ! start of BD%y(k)%BldMotion%TranslationDisp field + + BD%y(k)%ReactionForce%NNodes * 6 ! 2 fields with 3 components + + if (p_FAST%BD_OutputSibling) then + call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, BD_Start, BD_Out_Start ) + else + call AllocAry(TempMat, size(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,1), size(MeshMapData%BD_L_2_BD_L(k)%dM%mi,2), 'TempMat', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat>=AbortErrLev) return + + ! these blocks should be small enough that we can use matmul instead of calling a LAPACK routine to do it. + TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%mi) + call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) + + BD_Out_Start = BD_Out_Start + BD%y(k)%BldMotion%NNodes*3 ! start of BD%y(k)%BldMotion%Orientation field + TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%fx_p) + call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) + + deallocate(TempMat) ! the next blade may have a different number of nodes + end if + + END DO + + END IF ! aero loads + + ! U_ED_SD_HD_BD_Orca_Residual() in InputSolve Option 1; call to Transfer_ED_to_BD_tmp() + !IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN + + ! Transfer ED motions to BD inputs (dU^{BD}/dy^{ED}): + do k = 1,size(y_ED%BladeRootMotion) + !!! ! This linearization was done in forming dUdu (see Linear_BD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), ErrStat2, ErrMsg2 ) + + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ! ! start of BD%Input(1,k)%RootMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + + call Assemble_dUdy_Motions(y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), BD_Start, ED_Out_Start, dUdy) + end do + +END SUBROUTINE Linear_BD_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{AD}/dy^{IfW} block of dUdy. (i.e., how do changes in the IfW outputs affect the AD inputs?) +SUBROUTINE Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, u_AD, dUdy ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{IfW} block + + ! Local variables: + + INTEGER(IntKi) :: I ! Loops through components + INTEGER(IntKi) :: J ! Loops through nodes / elements + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: node + INTEGER(IntKi) :: AD_Start ! starting index of dUdy (row) where AD input equations (for specific fields) are located + + + !------------------------------------------------------------------------------------------------- + ! Set the inputs from inflow wind: + !------------------------------------------------------------------------------------------------- + !IF (p_FAST%CompInflow == MODULE_IfW) THEN !already checked in calling routine + + if (p_FAST%CompServo == MODULE_SrvD) then + node = 2 + else + node = 1 + end if + + + AD_Start = Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) ! start of u_AD%InflowOnBlade array + + do k=1,size(u_AD%rotors(1)%InflowOnBlade,3) ! blades + do j=1,size(u_AD%rotors(1)%InflowOnBlade,2) ! nodes + do i=1,3 !velocity component + dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki + end do + node = node + 1 + AD_Start = AD_Start + 3 + end do + end do + + if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then + do j=1,size(u_AD%rotors(1)%InflowOnTower,2) !nodes + do i=1,3 !velocity component + dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki + end do + node = node + 1 + AD_Start = AD_Start + 3 + end do + end if + + do i=1,3 !rotor-disk velocity component (DiskVel) + dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki + end do + node = node + 1 + AD_Start = AD_Start + 3 + + !END IF + + +END SUBROUTINE Linear_AD_InputSolve_IfW_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{AD}/dy^{ED} and dU^{AD}/dy^{BD} blocks of dUdy. (i.e., how do changes in the ED and BD outputs affect +!! the AD inputs?) +SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located + INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_AD_InputSolve_NoIfW_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn and/or BeamDyn: + !------------------------------------------------------------------------------------------------- + !................................... + ! tower + !................................... + IF (u_AD%rotors(1)%TowerMotion%Committed) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + + AD_Start = Indx_u_AD_Tower_Start(u_AD, y_FAST) ! start of u_AD%TowerMotion%TranslationDisp field + + ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, AD_Start, ED_Out_Start, dUdy, skipRotVel=.true.) + + END IF + + !................................... + ! hub + !................................... + CALL Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_H%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_H%dM%fx_p) + AD_Start = Indx_u_AD_Hub_Start(u_AD, y_FAST) ! start of u_AD%HubMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) ! start of y_ED%HubPtMotion%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) + + ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + y_ED%HubPtMotion%NNodes * 3 ! start of y_ED%HubPtMotion%Orientation field + call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%fx_p, AD_Start, ED_Out_Start ) + + ! *** AD orientation: from ED orientation + AD_Start = AD_Start + u_AD%rotors(1)%HubMotion%NNodes * 3 ! move past the AD translation disp field to orientation field + call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) + + ! *** AD rotational velocity: from ED rotational velocity + AD_Start = AD_Start + u_AD%rotors(1)%HubMotion%NNodes * 3 ! move past the AD orientation field to rotational velocity field + ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + y_ED%HubPtMotion%NNodes * 6 ! ! start of y_ED%HubPtMotion%RotationVel field + call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) + + + + !................................... + ! blade root + !................................... + DO k=1,size(y_ED%BladeRootMotion) + CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) + if (errStat>=AbortErrLev) return + + ! *** AD orientation: from ED orientation + AD_Start = Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, k) ! start of u_AD%BladeRootMotion(k)%Orientation field + + ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) & ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + + y_ED%BladeRootMotion(k)%NNodes * 3 ! start of y_ED%BladeRootMotion(k)%Orientation field + call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_R(k)%dM%mi, AD_Start, ED_Out_Start ) + + END DO + + + !................................... + ! blades + !................................... + IF (p_FAST%CompElast == Module_ED ) THEN + + + DO k=1,size(y_ED%BladeLn2Mesh) + !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + + AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field + ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field + CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, skipRotAcc=.true.) + + END DO + + ELSEIF (p_FAST%CompElast == Module_BD ) THEN + !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + + DO k=1,p_FAST%nBeams + AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field + BD_Out_Start = y_FAST%Lin%Modules(Module_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) + + CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, skipRotAcc=.true.) + END DO + + END IF + + +END SUBROUTINE Linear_AD_InputSolve_NoIfW_dy +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/du^{HD} blocks of dUdu. +SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn + TYPE(ED_OutputType),TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType),TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/du^{HD} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: HD_Start_td ! starting index of dUdu (column) where particular HD fields are located + INTEGER(IntKi) :: HD_Start_tr ! starting index of dUdu (row) where particular HD fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_du' + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: SubstructureMotion2HD + + + ErrStat = ErrID_None + ErrMsg = "" + + + + PlatformMotion => y_ED%PlatformPtMesh + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion2HD => y_SD%Y2Mesh + ELSE + SubstructureMotion2HD => PlatformMotion + END IF + ! look at how the translational displacement gets transfered to the translational velocity and translational acceleration: + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn: + !------------------------------------------------------------------------------------------------- + + !.......... + ! dU^{HD}/du^{HD} + ! note that the 1s on the diagonal have already been set, so we will fill in the off diagonal terms. + !.......... + + if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} + + !=================================================== + ! y_ED%PlatformPtMesh and u_HD%PRPMesh ! this is always done with ED, even if using SD + !=================================================== + + ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): + if ( u_HD%PRPMesh%Committed ) then + call Linearize_Point_to_Point( PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + + HD_Start_td = Indx_u_HD_PRP_Start(u_HD, y_FAST) + HD_Start_tr = HD_Start_td + u_HD%PRPMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_HD_PRP_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_PRP_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if + + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%PRPMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%ED_P_2_HD_PRP_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_PRP_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) + end if + end if + + + !=================================================== + ! y_ED%PlatformPtMesh or SD%y2Mesh and u_HD%Morison%Mesh + !=================================================== + ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): + if ( u_HD%Morison%Mesh%Committed ) then + call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + + HD_Start_td = Indx_u_HD_Morison_Start(u_HD, y_FAST) + HD_Start_tr = HD_Start_td + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%SubStructure_2_HD_M_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_M_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if + + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%SubStructure_2_HD_M_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_M_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) + end if + end if + + !=================================================== + ! y_ED%PlatformPtMesh or SD%y2Mesh and u_HD%WAMITMesh + !=================================================== + if ( u_HD%WAMITMesh%Committed ) then + + call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + HD_Start_td = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) + HD_Start_tr = HD_Start_td + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%SubStructure_2_HD_W_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_W_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if + + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%SubStructure_2_HD_W_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_W_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) + end if + end if + + end if + + +END SUBROUTINE Linear_HD_InputSolve_du +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect +!! the HD inputs?) +SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn + TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: HD_Start ! starting index of dUdy (column) where particular HD fields are located + INTEGER(IntKi) :: Platform_Out_Start! starting index of dUdy (row) where particular ED fields are located + INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: SubstructureMotion2HD + + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + + PlatformMotion => y_ED%PlatformPtMesh + Platform_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion2HD => y_SD%y2Mesh + SubStructure_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y2Mesh%TranslationDisp field + ELSE + SubstructureMotion2HD => PlatformMotion + SubStructure_Out_Start = Platform_Out_Start + END IF + + + !................................... + ! HD PRP Mesh + !................................... + ! use Indx_u_HD_PRP_Start + HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, HD_Start, Platform_Out_Start, dUdy, .false.) + + + ! dU^{HD}/dy^{ED} or ! dU^{HD}/dy^{SD} + !................................... + ! Morison Mesh + !................................... + IF (u_HD%Morison%Mesh%Committed) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Line2( SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) + + HD_Start = Indx_u_HD_Morison_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, HD_Start, SubStructure_Out_Start, dUdy, .false.) + END IF + + !................................... + ! Lumped Platform Reference Pt Mesh + !................................... + IF (u_HD%WAMITMesh%Committed) THEN + + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%Mesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + + HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) ! start of u_HD%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, HD_Start, SubStructure_Out_Start, dUdy, .false.) + END IF + + +END SUBROUTINE Linear_HD_InputSolve_dy + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{MAP}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect +!! the MAP inputs?) +SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(MAP_InputType), INTENT(INOUT) :: u_MAP !< The inputs to MAP + TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MAP}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: MAP_Start ! starting index of dUdy (column) where particular MAP fields are located + + INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located + TYPE(MeshType), POINTER :: SubstructureMotion + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MAP_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => y_SD%y3Mesh + SubStructure_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + ELSE + SubstructureMotion => y_ED%PlatformPtMesh + SubStructure_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + END IF + + IF (u_MAP%PtFairDisplacement%Committed) THEN + !................................... + ! FairLead Mesh + !................................... + + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! dU^{MAP}/dy^{SD} or ! dU^{MAP}/dy^{ED} + call Linearize_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, MAP_Start, SubStructure_Out_Start, dUdy, OnlyTranslationDisp=.true.) + + END IF +END SUBROUTINE Linear_MAP_InputSolve_dy + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{MD}/du^{MD} block of dUdu. (i.e., how do changes in the MD outputs affect +!! the MD inputs?) +SUBROUTINE Linear_MD_InputSolve_du( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< The inputs to MoorDyn + TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^{MD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: MD_Start_td ! starting index of dUdu (column) where particular MD fields are located + INTEGER(IntKi) :: MD_Start_tr ! starting index of dUdu (row) where particular MD fields are located + + TYPE(MeshType), POINTER :: SubstructureMotion + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_du' + + + ErrStat = ErrID_None + ErrMsg = "" + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => y_SD%y3Mesh + ELSE + SubstructureMotion => y_ED%PlatformPtMesh + END IF + + IF (u_MD%CoupledKinematics(1)%Committed) THEN + !................................... + ! FairLead Mesh + !................................... + + ! dU^{MD}/du^{MD} + call Linearize_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + + ! MD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + MD_Start_td = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + MD_Start_tr = MD_Start_td + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%Structure_2_Mooring%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%Structure_2_Mooring%dM%tv_ud, MD_Start_tr, MD_Start_td ) + end if + + ! translational acceleration: + MD_Start_tr = MD_Start_tr + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%Structure_2_Mooring%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%Structure_2_Mooring%dM%ta_ud, MD_Start_tr, MD_Start_td ) + end if + + END IF +END SUBROUTINE Linear_MD_InputSolve_du + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{MD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect +!! the MD inputs?) +SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< The inputs to MoorDyn + TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: MD_Start ! starting index of dUdy (column) where particular MD fields are located + INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located + TYPE(MeshType), POINTER :: SubstructureMotion + + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + IF (u_MD%CoupledKinematics(1)%Committed) THEN + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => y_SD%y3Mesh + SubStructure_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + ELSE + SubstructureMotion => y_ED%PlatformPtMesh + SubStructure_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + END IF + + !................................... + ! FairLead Mesh + !................................... + + MD_Start = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! dU^{MD}/dy^{SD} or dU^{MD}/dy^{ED} + + !!! ! This linearization was done in forming dUdu (see Linear_MD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + + call Assemble_dUdy_Motions( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, MD_Start, SubStructure_Out_Start, dUdy, OnlyTranslationDisp=.false.) + + END IF +END SUBROUTINE Linear_MD_InputSolve_dy + +!---------------------------------------------------------------------------------------------------------------------------------- + +!> This routine allocates the state matrices for the glue code and concatenates the module-level state matrices into +!! the first step of computing the full system state matrices. This routine returns +!! \f$ A = A^{ED} \f$, \f$ B = \begin{bmatrix} 0 & 0 & B^{ED} & 0 \end{bmatrix} \f$, +!! \f$ C = \begin{bmatrix} 0 \\ 0 \\ C^{ED} \\ 0 \end{bmatrix} \f$, and +!! \f$ D = \begin{bmatrix} D^{IfW} & 0 & 0 & 0 \\ 0 & D^{SrvD} & 0 & 0 \\ 0 & 0 & D^{ED} & 0 \\ 0 & 0 & 0 & D^{AD}\end{bmatrix}\f$. +SUBROUTINE Glue_FormDiag( p_FAST, y_FAST, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + + ! local variables + INTEGER(IntKi) :: ThisModule ! Module ID # + + INTEGER(IntKi) :: i ! module loop counter + INTEGER(IntKi) :: k ! module instance loop counter + INTEGER(IntKi) :: r ! row loop counter + INTEGER(IntKi) :: c ! column loop counter + INTEGER(IntKi) :: r_start ! row in glue matrix where module block matrix starts + INTEGER(IntKi) :: c_start ! column in glue matrix where module block matrix starts + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'Glue_FormDiag' + + ErrStat = ErrID_None + ErrMsg = "" + + + + !..................................... + ! Allocate the state matrices if necessary: + !..................................... + + if (.not. allocated(y_FAST%Lin%Glue%A)) then ! assume none of them are allocated + ! A: rows = x; columns = x + call AllocAry(y_FAST%Lin%Glue%A, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), & + y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'A', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !B: rows = x; columns = u + call AllocAry(y_FAST%Lin%Glue%B, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), & + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'B', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !C: rows = y; columns = x + call AllocAry(y_FAST%Lin%Glue%C, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), & + y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'C', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !D: rows = y; columns = u + call AllocAry(y_FAST%Lin%Glue%D, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), & + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'D', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat>=AbortErrLev) return + end if + + + ! The equations of the matrices returned from this routine are really just a general form with the null matrices removed: + + ! A + y_FAST%Lin%Glue%A = 0.0_R8Ki + r_start = 1 + c_start = 1 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + if (allocated( y_FAST%Lin%Modules(ThisModule)%Instance(k)%A) ) then + do c=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%A, 2) + do r=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%A, 1) + y_FAST%Lin%Glue%A(r_start + r - 1, c_start + c - 1) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%A(r,c) + end do + end do + end if + + r_start = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + c_start = c_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + end do + end do + + + ! B + y_FAST%Lin%Glue%B = 0.0_R8Ki + r_start = 1 + c_start = 1 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + if (allocated( y_FAST%Lin%Modules(ThisModule)%Instance(k)%B) ) then + do c=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%B, 2) + do r=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%B, 1) + y_FAST%Lin%Glue%B(r_start + r - 1, c_start + c - 1) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%B(r,c) + end do + end do + end if + + r_start = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + c_start = c_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_INPUT_COL) + end do + end do + + ! C + y_FAST%Lin%Glue%C = 0.0_R8Ki + r_start = 1 + c_start = 1 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + if (allocated( y_FAST%Lin%Modules(ThisModule)%Instance(k)%C) ) then + do c=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%C, 2) + do r=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%C, 1) + y_FAST%Lin%Glue%C(r_start + r - 1, c_start + c - 1) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%C(r,c) + end do + end do + end if + + r_start = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) + c_start = c_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + end do + end do + + ! D + y_FAST%Lin%Glue%D = 0.0_R8Ki + r_start = 1 + c_start = 1 + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + if (allocated( y_FAST%Lin%Modules(ThisModule)%Instance(k)%D) ) then + do c=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%D, 2) + do r=1,size( y_FAST%Lin%Modules(ThisModule)%Instance(k)%D, 1) + y_FAST%Lin%Glue%D(r_start + r - 1, c_start + c - 1) = y_FAST%Lin%Modules(ThisModule)%Instance(k)%D(r,c) + end do + end do + end if + + r_start = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) + c_start = c_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_INPUT_COL) + end do + end do + + +END SUBROUTINE Glue_FormDiag +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the full-system state matrices for linearization: A, B, C, and D. +!! Note that it uses LAPACK_GEMM instead of MATMUL for matrix multiplications because of stack-space issues (these +!! matrices get large quickly). +SUBROUTINE Glue_StateMatrices( p_FAST, y_FAST, dUdu, dUdy, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< glue-code Jacobian: \f$ \frac{\partial U}{\partial u} \f$; on exit will hold G^{-1}*dUdu + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< glue-code Jacobian: \f$ \frac{\partial U}{\partial y} \f$; on exit will hold G^{-1}*dUdy + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + + ! local variables + REAL(R8Ki), ALLOCATABLE :: G(:,:), tmp(:,:) ! variables for glue-code linearization + INTEGER(IntKi), ALLOCATABLE :: ipiv(:) + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'Glue_StateMatrices' + + ErrStat = ErrID_None + ErrMsg = "" + + !LIN-TODO: Update doc string comments below for SrvD, HD, MAP, SD + + !..................................... + ! allocate the glue-code state matrices; after this call they will contain the state matrices from the + ! modules (without glue-code influence) on their diagonals + !..................................... + call Glue_FormDiag( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + !if (p_FAST%LinInputs == LIN_NONE .or. p_FAST%LinOutputs == LIN_NONE) then + ! the glue-code input-output solve doesn't affect the rest of the equations, so we'll just return early + ! call cleanup() + ! return + !end if + + + !..................................... + ! solve for state matrices: + !..................................... + + ! *** get G matrix **** + !---------------------- + if (.not. allocated(G)) then + call AllocAry(G, size(dUdu,1), size(dUdu,2), 'G', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call AllocAry( ipiv, size(dUdu,1), 'ipiv', ErrStat2, ErrMsg2 ) ! size(G,1) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + end if + + !G = dUdu + matmul( dUdy, y_FAST%Lin%Glue%D ) + G = dUdu + call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, G, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! because G can be ill-conditioned, we are going to precondition with G_hat = S^(-1) * G * S + ! we will also multiply the right-hand-side of the equations that need G inverse so that + ! dUdy_hat = S^(-1)*dUdy and dUdu_hat = S^(-1)*dUdu + call Precondition(p_FAST, y_FAST, G, dUdu, dUdy) + + + ! now we need to form G_hat^(-1) * (S^-1*dUdy) and G^(-1) * (S^-1*dUdu) + ! factor G for the two solves: + CALL LAPACK_getrf( M=size(G,1), N=size(G,2), A=G, IPIV=ipiv, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + + ! after the this solve, dUdy holds G_hat^(-1) * dUdy_hat: + CALL LAPACK_getrs( trans='N', N=size(G,2), A=G, IPIV=ipiv, B=dUdy, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! after the this solve, dUdu holds G_hat^(-1) * dUdu_hat: + CALL LAPACK_getrs( trans='N', N=size(G,2), A=G, IPIV=ipiv, B=dUdu, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + deallocate(G) ! we're finished with the solves, so let's get rid of them + deallocate(ipiv) ! we're finished with the solves, so let's get rid of them + + ! after this call, dUdu holds G^(-1)*dUdu and dUdy holds G^(-1)*dUdy: + call Postcondition(p_FAST, y_FAST, dUdu, dUdy) + + + ! *** get tmp matrix for A and C calculations **** + !---------------------- + call AllocAry(tmp, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'G^-1*dUdy*C', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (errStat>=AbortErrLev) then + call cleanup() + return + end if + + !tmp = G^(-1) * dUdy * diag(C) + call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%C, 0.0_R8Ki, tmp, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + ! A + !---------------------- + !> \f{equation}{ A = + !! \begin{bmatrix} A^{ED} & 0 & 0 \\ 0 & A^{BD} & 0 \\ 0 & 0 & A^{HD}\end{bmatrix} - + !! \begin{bmatrix} 0 & 0 & B^{ED} & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & B^{BD} & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & B^{HD}\end{bmatrix} \, + !! \begin{bmatrix} G \end{bmatrix}^{-1} \, \frac{\partial U}{\partial y} \, \begin{bmatrix} 0 & 0 & 0 \\ 0 & 0 & 0 \\ C^{ED} & 0 & 0 \\ 0 & C^{BD} & 0 \\ 0 & 0 & 0 \\ 0 & 0 & C^{HD} \\ 0 & 0 & 0\end{bmatrix} + !! \f} + !y_FAST%Lin%Glue%A = y_FAST%Lin%Glue%A - matmul( y_FAST%Lin%Glue%B, tmp ) + call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, y_FAST%Lin%Glue%B, tmp, 1.0_R8Ki, y_FAST%Lin%Glue%A, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! C + !---------------------- + !> \f{equation}{ C = \begin{bmatrix} 0 & 0 \\ 0 & 0 \\ C^{ED} & 0 \\ 0 & C^{BD} \\ 0 & 0 \end{bmatrix} - + !! \begin{bmatrix} D^{IfW} & 0 & 0 & 0 & 0 \\ 0 & D^{SrvD} & 0 & 0 & 0 \\ 0 & 0 & D^{ED} & 0 & 0 \\ 0 & 0 & 0 & D^{BD} & 0\\ 0 & 0 & 0 & 0 & D^{AD}\end{bmatrix} \, + !! \begin{bmatrix} G \end{bmatrix}^{-1} \, \frac{\partial U}{\partial y} \, \begin{bmatrix} 0 & 0 \\ 0 & 0 \\ C^{ED} & 0 \\ 0 & C^{BD} \\ 0 & 0 \end{bmatrix} + !! \f} + !y_FAST%Lin%Glue%C = y_FAST%Lin%Glue%C - matmul( y_FAST%Lin%Glue%D, tmp ) + call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, y_FAST%Lin%Glue%D, tmp, 1.0_R8Ki, y_FAST%Lin%Glue%C, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + deallocate(tmp) + + + ! B + !---------------------- + !> \f{equation}{ B = \begin{bmatrix} 0 & 0 \\ 0 & 0 \\ B^{ED} & 0 \\ 0 & B^{BD} \\ 0 & 0 \end{bmatrix} \, + !! \begin{bmatrix} G \end{bmatrix}^{-1} \, \frac{\partial U}{\partial u} + !! \f} + call AllocAry(tmp,size(y_FAST%Lin%Glue%B,1),size(y_FAST%Lin%Glue%B,2),'tmp',ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (errStat>=AbortErrLev) then + call cleanup() + return + end if + tmp = y_FAST%Lin%Glue%B + + !y_FAST%Lin%Glue%B = matmul( y_FAST%Lin%Glue%B, dUdu ) + call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, y_FAST%Lin%Glue%B, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + deallocate(tmp) + + ! D + !---------------------- + !> \f{equation}{ D = \begin{bmatrix} D^{IfW} & 0 & 0 & 0 & 0 \\ 0 & D^{SrvD} & 0 & 0 & 0 \\ 0 & 0 & D^{ED} & 0 & 0 \\ 0 & 0 & 0 & D^{BD} & 0\\ 0 & 0 & 0 & 0 & D^{AD}\end{bmatrix} \, + !! \begin{bmatrix} G \end{bmatrix}^{-1} \, \frac{\partial U}{\partial u} + !! \f} + call AllocAry(tmp,size(y_FAST%Lin%Glue%D,1),size(y_FAST%Lin%Glue%D,2),'tmp',ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (errStat>=AbortErrLev) then + call cleanup() + return + end if + tmp = y_FAST%Lin%Glue%D + + !y_FAST%Lin%Glue%D = matmul( y_FAST%Lin%Glue%D, dUdu ) + call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, tmp, dUdu, 0.0_R8Ki, y_FAST%Lin%Glue%D, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + deallocate(tmp) + + call cleanup() + +contains + subroutine cleanup() + if (allocated(ipiv)) deallocate(ipiv) + if (allocated(G)) deallocate(G) + if (allocated(tmp)) deallocate(tmp) + end subroutine cleanup +END SUBROUTINE Glue_StateMatrices +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the preconditioned matrix, \f$ \hat{G} \f$, such that \f$ \hat{G} = S^(-1) G S \f$ with \f$S^(-1)\f$ defined +!! such that loads are scaled by p_FAST\%UJacSclFact. It also returns the preconditioned matrices \f$ \hat{dUdu} \f$ and +!! \f$ \hat{dUdy} \f$ such that \f$ \hat{dUdu} = S^(-1) dUdu \f$ and +!! \f$ \hat{dUdy} = S^(-1) dUdy \f$ for the right-hand sides of the equations to be solved. +SUBROUTINE Precondition(p_FAST, y_FAST, G, dUdu, dUdy) + + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + REAL(R8Ki), INTENT(INOUT) :: G(:,:) !< variable for glue-code linearization (in is G; out is G_hat) + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< jacobian in FAST linearization from right-hand-side of equation + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< jacobian in FAST linearization from right-hand-side of equation + + integer :: r, c + + !! Change G to G_hat: + do c = 1,size(y_FAST%Lin%Glue%IsLoad_u) + + if ( y_FAST%Lin%Glue%IsLoad_u(c) ) then + + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + if ( .not. y_FAST%Lin%Glue%IsLoad_u(r) ) then + ! column is load, but row is a motion: + G(r,c) = G(r,c) * p_FAST%UJacSclFact + end if + end do + + else + + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + ! column is motion, but row is a load: + G(r,c) = G(r,c) / p_FAST%UJacSclFact + end if + end do + + end if + + end do + + + !! Change dUdu to dUdu_hat (note that multiplying on the left multiplies the entire row): + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + dUdu(r,:) = dUdu(r,:) / p_FAST%UJacSclFact + end if + + end do + + !! Change dUdy to dUdy_hat: + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + dUdy(r,:) = dUdy(r,:) / p_FAST%UJacSclFact + end if + + end do + + +END SUBROUTINE Precondition +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the matrices \f$ \tilde{dUdu} \f$ and \f$ \tilde{dUdy} \f$ such that +!! \f$ \tilde{dUdu} = G^(-1) dUdu \f$ and +!! \f$ \tilde{dUdy} = G^(-1) dUdy \f$, which have been solved using the preconditioned system defined in fast_lin::precondition. +SUBROUTINE Postcondition(p_FAST, y_FAST, dUdu, dUdy) + + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< jacobian in FAST linearization from right-hand-side of equation + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< jacobian in FAST linearization from right-hand-side of equation + + integer :: r + + !! Change S^(-1) * G_hat^(-1) * dUdu_hat to G^(-1) * dUdu (note that multiplying on the left multiplies the entire row): + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + dUdu(r,:) = dUdu(r,:) * p_FAST%UJacSclFact + end if + + end do + + !! Change S^(-1) * G_hat^(-1) * dUdy_hat to G^(-1) * dUdy (note that multiplying on the left multiplies the entire row): + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + dUdy(r,:) = dUdy(r,:) * p_FAST%UJacSclFact + end if + + end do + + +END SUBROUTINE Postcondition +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetBlockMatrix( matrix, submatrix, RowStart, ColStart ) + REAL(R8Ki), INTENT(INOUT) :: matrix(:,:) !< matrix that will have the negative of the submatrix block added to it + REAL(R8Ki), INTENT(IN ) :: submatrix(:,:) !< block matrix that needs to be added to matrix + INTEGER(IntKi), INTENT(IN ) :: RowStart !< first row in matrix where submatrix should start + INTEGER(IntKi), INTENT(IN ) :: ColStart !< first column in matrix where submatrix should start + + INTEGER(IntKi) :: col + INTEGER(IntKi) :: row + + + do col=1,size( submatrix, 2) + do row=1,size( submatrix, 1) + matrix(RowStart + row - 1, ColStart + col - 1) = - submatrix(row,col) ! note the negative sign here!!!! + end do + end do + + +END SUBROUTINE SetBlockMatrix +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SumBlockMatrix( matrix, submatrix, RowStart, ColStart ) + REAL(R8Ki), INTENT(INOUT) :: matrix(:,:) !< matrix that will have the negative of the submatrix block added to it + REAL(R8Ki), INTENT(IN ) :: submatrix(:,:) !< block matrix that needs to be added to matrix + INTEGER(IntKi), INTENT(IN ) :: RowStart !< first row in matrix where submatrix should start + INTEGER(IntKi), INTENT(IN ) :: ColStart !< first column in matrix where submatrix should start + + INTEGER(IntKi) :: col + INTEGER(IntKi) :: row + + + do col=1,size( submatrix, 2) + do row=1,size( submatrix, 1) + matrix(RowStart + row - 1, ColStart + col - 1) = matrix(RowStart + row - 1, ColStart + col - 1) & + - submatrix(row,col) ! note the negative sign here!!!! + end do + end do + + +END SUBROUTINE SumBlockMatrix +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine assembles the linearization matrices for transfer of motion fields between two meshes. +!> It set the following block matrix, which is the dUdy block for transfering output (source) mesh \f$y\f$ to the +!! input (destination) mesh \f$u\f$:\n +!! \f$ M = - \begin{bmatrix} M_{mi} & M_{f_{\times p}} & 0 & 0 & 0 & 0 \\ +!! 0 & M_{mi} & 0 & 0 & 0 & 0 \\ +!! M_{tv\_uS} & 0 & M_{mi} & M_{f_{\times p}} & 0 & 0 \\ +!! 0 & 0 & 0 & M_{mi} & 0 & 0 \\ +!! M_{ta\_uS} & 0 & 0 & M_{ta\_rv} & M_{mi} & M_{f_{\times p}} \\ +!! 0 & 0 & 0 & 0 & 0 & M_{mi} \\ +!! \end{bmatrix} \f$ +!! where the matrices correspond to +!! \f$ \left\{ \begin{matrix} +!! \vec{u}^S \\ +!! \vec{\theta}^S \\ +!! \vec{v}^S \\ +!! \vec{\omega}^S \\ +!! \vec{a}^S \\ +!! \vec{\alpha}^S \\ +!! \end{matrix} \right\} \f$ +SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, skipRotVel, skipRotAcc, onlyTranslationDisp) + TYPE(MeshType), INTENT(IN) :: y !< the output (source) mesh that is transfering motions + TYPE(MeshType), INTENT(IN) :: u !< the input (destination) mesh that is receiving motions + TYPE(MeshMapType), INTENT(IN) :: MeshMap !< the mesh mapping from y to u + INTEGER(IntKi), INTENT(IN) :: BlockRowStart !< the index of the row defining the block of dUdy to be set + INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< full Jacobian matrix + LOGICAL, OPTIONAL, INTENT(IN) :: skipRotVel !< if present and true, we skip the rotational velocity and both acceleration fields and return early + LOGICAL, OPTIONAL, INTENT(IN) :: onlyTranslationDisp !< if present and true, we set only the destination translationDisp fields and return early + LOGICAL, OPTIONAL, INTENT(IN) :: skipRotAcc !< if present and true, we skip the rotational acceleration field + + INTEGER(IntKi) :: row + INTEGER(IntKi) :: col + +!! \f$M_{mi}\f$ is modmesh_mapping::meshmaplinearizationtype::mi (motion identity)\n +!! \f$M_{f_{\times p}}\f$ is modmesh_mapping::meshmaplinearizationtype::fx_p \n +!! \f$M_{tv\_uD}\f$ is modmesh_mapping::meshmaplinearizationtype::tv_uD \n +!! \f$M_{tv\_uS}\f$ is modmesh_mapping::meshmaplinearizationtype::tv_uS \n +!! \f$M_{ta\_uD}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_uD \n +!! \f$M_{ta\_uS}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_uS \n +!! \f$M_{ta\_rv}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_rv \n + + !*** row for translational displacement *** + ! source translational displacement to destination translational displacement: + row = BlockRowStart ! start of u%TranslationDisp field + col = BlockColStart ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + + ! source orientation to destination translational displacement: + row = BlockRowStart ! start of u%TranslationDisp field + col = BlockColStart + y%NNodes*3 ! start of y%Orientation field [skip 1 field with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + + + if (PRESENT(onlyTranslationDisp)) then + if (onlyTranslationDisp) return ! destination includes only the translational displacement field, so we'll just return + end if + + + !*** row for orientation *** + ! source orientation to destination orientation: + row = BlockRowStart + u%NNodes*3 ! start of u%Orientation field [skip 1 field with 3 components] + col = BlockColStart + y%NNodes*3 ! start of y%Orientation field [skip 1 field with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + + + !*** row for translational velocity *** + ! source translational displacement to destination translational velocity: + row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] + col = BlockColStart ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%tv_us, row, col ) + + ! source translational velocity to destination translational velocity: + row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] + col = BlockColStart + y%NNodes*6 ! start of y%TranslationVel field [skip 2 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + + ! source rotational velocity to destination translational velocity: + row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] + col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + + + if (PRESENT(skipRotVel)) then + if (skipRotVel) return ! destination does not include rotational velocities or accelerations, so we'll just return + end if + + + !*** row for rotational velocity *** + ! source rotational velocity to destination rotational velocity: + row = BlockRowStart + u%NNodes*9 ! start of u%RotationVel field [skip 3 fields with 3 components] + col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + + + !*** row for translational acceleration *** + ! source translational displacement to destination translational acceleration: + row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] + col = BlockColStart ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%ta_us, row, col ) + + ! source rotational velocity to destination translational acceleration: + row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] + col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%ta_rv, row, col ) + + ! source translational acceleration to destination translational acceleration: + row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] + col = BlockColStart + y%NNodes*12 ! start of y%TranslationAcc field [skip 4 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + + ! source rotational acceleration to destination translational acceleration: + row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] + col = BlockColStart + y%NNodes*15 ! start of y%RotationAcc field [skip 5 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + + + if (PRESENT(skipRotAcc)) then + if (skipRotAcc) return ! destination does not include rotational accelerations, so we'll just return + end if + + + !*** row for rotational acceleration *** + ! source rotational acceleration to destination rotational acceleration + row = BlockRowStart + u%NNodes*15 ! start of u%RotationAcc field [skip 5 fields with 3 components] + col = BlockColStart + y%NNodes*15 ! start of y%RotationAcc field [skip 5 fields with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + + +END SUBROUTINE Assemble_dUdy_Motions +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine assembles the linearization matrices for transfer of load fields between two meshes. +!> It set the following block matrix, which is the dUdy block for transfering output (source) mesh \f$y\f$ to the +!! input (destination) mesh \f$u\f$:\n +!! \f$ M = - \begin{bmatrix} M_{li} & 0 \\ +!! M_{fm} & M_{li} \\ +!! \end{bmatrix} \f$ +!! & M_{mi} & } +!! \f$ \left\{ \begin{matrix} +!! \vec{F}^S \\ +!! \vec{M}^S +!! \end{matrix} \right\} \f$ +SUBROUTINE Assemble_dUdy_Loads(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy) + TYPE(MeshType), INTENT(IN) :: y !< the output (source) mesh that is transfering loads + TYPE(MeshType), INTENT(IN) :: u !< the input (destination) mesh that is receiving loads + TYPE(MeshMapType), INTENT(IN) :: MeshMap !< the mesh mapping from y to u + INTEGER(IntKi), INTENT(IN) :: BlockRowStart !< the index of the row defining the block of dUdy to be set + INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< full Jacobian matrix + + INTEGER(IntKi) :: row + INTEGER(IntKi) :: col + + !*** row for force *** + ! source force to destination force: + row = BlockRowStart ! start of u%Force field + col = BlockColStart ! start of y%Force field + call SetBlockMatrix( dUdy, MeshMap%dM%li, row, col ) + + !*** row for moment *** + ! source force to destination moment: + row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] + col = BlockColStart ! start of y%Force field + call SetBlockMatrix( dUdy, MeshMap%dM%m_f, row, col ) + + if (allocated(y%Moment)) then + ! source moment to destination moment: + row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] + col = BlockColStart + y%NNodes*3 ! start of y%Moment field [skip 1 field with 3 components] + call SetBlockMatrix( dUdy, MeshMap%dM%li, row, col ) + end if + +END SUBROUTINE Assemble_dUdy_Loads + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%BladePtLoads(BladeNum) mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_Blade_Start(u_ED, y_FAST, BladeNum) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER :: ED_Start !< starting index of this blade mesh in ElastoDyn inputs + + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + if (allocated(u_ED%BladePtLoads)) then + do k = 1,min(BladeNum-1, size(u_ED%BladePtLoads)) + ED_Start = ED_Start + u_ED%BladePtLoads(k)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade + end do + end if + +END FUNCTION Indx_u_ED_Blade_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%PlatformPtMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_Platform_Start(u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + INTEGER :: ED_Start !< starting index of this mesh + + ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, MaxNBlades+1) ! skip all of the blades to get to start of platform +END FUNCTION Indx_u_ED_Platform_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%TowerPtLoads mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_Tower_Start(u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + + INTEGER :: ED_Start !< starting index of this mesh + + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + ED_Start = ED_Start + u_ED%PlatformPtMesh%NNodes * 6 ! 3 forces + 3 moments at each node +END FUNCTION Indx_u_ED_Tower_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%HubPtLoad mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_Hub_Start(u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + + INTEGER :: ED_Start !< starting index of this mesh + + ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + ED_Start = ED_Start + u_ED%TowerPtLoads%NNodes * 6 ! 3 forces + 3 moments at each node +END FUNCTION Indx_u_ED_Hub_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%NacelleLoads mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_Nacelle_Start(u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + + INTEGER :: ED_Start !< starting index of this mesh + + ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) + ED_Start = ED_Start + u_ED%HubPtLoad%NNodes * 6 ! 3 forces + 3 moments at each node +END FUNCTION Indx_u_ED_Nacelle_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%BladePitchCom array in the FAST linearization inputs. +FUNCTION Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + + INTEGER :: ED_Start !< starting index of this mesh + + ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + ED_Start = ED_Start + u_ED%NacelleLoads%NNodes * 6 ! 3 forces + 3 moments at each node +END FUNCTION Indx_u_ED_BlPitchCom_Start +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%BladeLn2Mesh(BladeNum) mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_Blade_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + ED_Out_Start = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field (blade motions in y_ED) + if (allocated(y_ED%BladeLn2Mesh)) then + do k = 1,min(BladeNum-1,SIZE(y_ED%BladeLn2Mesh,1)) ! Loop through all blades (p_ED%NumBl) + ED_Out_Start = ED_Out_Start + y_ED%BladeLn2Mesh(k)%NNodes*18 ! 6 fields with 3 components on each blade + end do + end if + +END FUNCTION Indx_y_ED_Blade_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%PlatformPtMesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_Platform_Start(y_ED, y_FAST) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + + INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs + + ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, MaxNBlades+1) ! skip all of the blades to get to start of platform +END FUNCTION Indx_y_ED_Platform_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%TowerLn2Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_Tower_Start(y_ED, y_FAST) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + + INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs + + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) + ED_Out_Start = ED_Out_Start + y_ED%PlatformPtMesh%NNodes*18 ! 6 fields with 3 components +END FUNCTION Indx_y_ED_Tower_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%HubPtMesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_Hub_Start(y_ED, y_FAST) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + + INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs + + ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) + ED_Out_Start = ED_Out_Start + y_ED%TowerLn2Mesh%NNodes*18 ! 6 fields with 3 components +END FUNCTION Indx_y_ED_Hub_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%BladeRootMotion(BladeNum) mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + ED_Out_Start = ED_Out_Start + y_ED%HubPtMotion%NNodes*9 ! 3 fields with 3 components + + do k = 1,min(BladeNum-1,size(y_ED%BladeRootMotion)) + ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(k)%NNodes*18 + end do +END FUNCTION Indx_y_ED_BladeRoot_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%NacelleMotion mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_Nacelle_Start(y_ED, y_FAST) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + INTEGER :: k !< blade number loop + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, size(y_ED%BladeRootMotion)) ! start of last blade root + ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(size(y_ED%BladeRootMotion))%NNodes*18 ! N blade roots, 6 fields with 3 components per blade. +END FUNCTION Indx_y_ED_Nacelle_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for y_ED%Yaw in the FAST linearization outputs. +FUNCTION Indx_y_Yaw_Start(y_FAST, ThisModule) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + INTEGER, INTENT(IN ) :: ThisModule !< which structural module this is for + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + + ED_Out_Start = y_FAST%Lin%Modules(thisModule)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(thisModule)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) + - y_FAST%Lin%Modules(thisModule)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + +END FUNCTION Indx_y_Yaw_Start +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%TowerMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Tower_Start(u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + +END FUNCTION Indx_u_AD_Tower_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%HubMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Hub_Start(u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + + AD_Start = Indx_u_AD_Tower_Start(u_AD, y_FAST) + u_AD%rotors(1)%TowerMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components + +END FUNCTION Indx_u_AD_Hub_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%BladeRootMotion(k) mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + + AD_Start = Indx_u_AD_Hub_Start(u_AD, y_FAST) + u_AD%rotors(1)%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components + + do k = 1,min(BladeNum-1,size(u_AD%rotors(1)%BladeRootMotion)) + AD_Start = AD_Start + u_AD%rotors(1)%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components + end do +END FUNCTION Indx_u_AD_BladeRoot_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%BladeMotion(k) mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Blade_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + + AD_Start = Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, MaxNBlades+1) + + do k = 1,min(BladeNum-1,size(u_AD%rotors(1)%BladeMotion)) + AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 15 ! 5 fields (TranslationDisp, MASKID_Orientation, TranslationVel, RotationVel, TranslationAcc) with 3 components + end do +END FUNCTION Indx_u_AD_Blade_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%InflowOnBlade array in the FAST linearization inputs. +FUNCTION Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + + INTEGER :: AD_Start !< starting index of this array in AeroDyn inputs + + AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, MaxNBlades+1) + +END FUNCTION Indx_u_AD_BladeInflow_Start +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_SD%TPMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_SD_TPMesh_Start(u_SD, y_FAST) RESULT(SD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_InputType), INTENT(IN ) :: u_SD !< SD Inputs at t + + INTEGER :: SD_Start !< starting index of this mesh in SubDyn inputs + + SD_Start = y_FAST%Lin%Modules(Module_SD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + +END FUNCTION Indx_u_SD_TPMesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_SD%Y1Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t + + INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + + SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) +END FUNCTION Indx_y_SD_Y1Mesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_SD%Y2Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t + + INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + + SD_Out_Start = Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) + y_SD%Y1Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of +END FUNCTION Indx_y_SD_Y2Mesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_SD%Y3Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t + + INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + + SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) + y_SD%Y2Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of +END FUNCTION Indx_y_SD_Y3Mesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_SD%TPMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_SD_LMesh_Start(u_SD, y_FAST) RESULT(SD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_InputType), INTENT(IN ) :: u_SD !< SD Inputs at t + + INTEGER :: SD_Start !< starting index of this mesh in SubDyn inputs + + SD_Start = Indx_u_SD_TPMesh_Start(u_SD, y_FAST) + u_SD%TPMesh%NNodes*18 ! 6 fields with 3 components + +END FUNCTION Indx_u_SD_LMesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%Morison%Mesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_HD_Morison_Start(u_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(IN ) :: u_HD !< HD Inputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = y_FAST%Lin%Modules(Module_HD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + +END FUNCTION Indx_u_HD_Morison_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%WAMITMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_HD_WAMIT_Start(u_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(IN ) :: u_HD !< HD Inputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = Indx_u_HD_Morison_Start(u_HD, y_FAST) + if (u_HD%Morison%Mesh%committed) HD_Start = HD_Start + u_HD%Morison%Mesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components + +END FUNCTION Indx_u_HD_WAMIT_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%PRPMesh mesh in the FAST linearization inputs. +FUNCTION Indx_u_HD_PRP_Start(u_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_InputType), INTENT(IN ) :: u_HD !< HD Inputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) + if (u_HD%WAMITMesh%committed) HD_Start = HD_Start + u_HD%WAMITMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components + + END FUNCTION Indx_u_HD_PRP_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_HD%Morison%DistribMesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_HD_Morison_Start(y_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HD Outputs at t + + INTEGER :: HD_Start !< starting index of this mesh in HydroDyn Outputs + + HD_Start = y_FAST%Lin%Modules(Module_HD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + +END FUNCTION Indx_y_HD_Morison_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_HD%Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_HD_WAMIT_Start(y_HD, y_FAST) RESULT(HD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HD Outputs at t + + INTEGER :: HD_Start + + !< starting index of this mesh in HydroDyn Outputs + + HD_Start = Indx_y_HD_Morison_Start(y_HD, y_FAST) + if (y_HD%Morison%Mesh%committed) HD_Start = HD_Start + y_HD%Morison%Mesh%NNodes * 6 ! 2 fields (MASKID_FORCE,MASKID_MOMENT) with 3 components + + END FUNCTION Indx_y_HD_WAMIT_Start +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine allocates the arrays that store the operating point at each linearization time for later producing VTK +!! files of the mode shapes. +SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(*), PARAMETER :: RoutineName = 'AllocateOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + + ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + + IF ( p_FAST%CompElast == Module_BD ) THEN + ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + ! if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + +END SUBROUTINE AllocateOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is the inverse of SetOperatingPoint(). It saves the current operating points so they can be retrieved +!> when visualizing mode shapes. +SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, CtrlCode ) + + INTEGER(IntKi) , INTENT(IN ) :: i !< current index into LinTimes + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(IN ) :: CtrlCode !< mesh copy control code (new, vs update) + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SaveOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy states and inputs to OP array + CALL ED_CopyContState (ED%x( STATE_CURR), y_FAST%op%x_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), y_FAST%op%xd_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), y_FAST%op%z_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), y_FAST%op%OtherSt_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (ED%Input(1), y_FAST%op%u_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy states and inputs to OP array + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_CURR), y_FAST%op%x_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), y_FAST%op%xd_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), y_FAST%op%z_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (BD%Input(1,k), y_FAST%op%u_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + + + ! AeroDyn: copy states and inputs to OP array + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (AD%x( STATE_CURR), y_FAST%op%x_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), y_FAST%op%xd_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), y_FAST%op%z_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (AD%Input(1), y_FAST%op%u_AD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy states and inputs to OP array + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), y_FAST%op%x_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), y_FAST%op%xd_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), y_FAST%op%z_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt( STATE_CURR), y_FAST%op%OtherSt_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (IfW%Input(1), y_FAST%op%u_IfW(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy states and inputs to OP array + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), y_FAST%op%x_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), y_FAST%op%xd_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), y_FAST%op%z_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), y_FAST%op%OtherSt_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (SrvD%Input(1), y_FAST%op%u_SrvD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy states and inputs to OP array + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), y_FAST%op%x_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), y_FAST%op%xd_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), y_FAST%op%z_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (HD%Input(1), y_FAST%op%u_HD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), y_FAST%op%x_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), y_FAST%op%xd_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), y_FAST%op%z_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), y_FAST%op%OtherSt_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), y_FAST%op%u_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (MAPp%x( STATE_CURR), y_FAST%op%x_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), y_FAST%op%xd_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), y_FAST%op%z_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MAP(i), CtrlCode, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (MAPp%Input(1), y_FAST%op%u_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (MD%x( STATE_CURR), y_FAST%op%x_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), y_FAST%op%xd_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), y_FAST%op%z_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (MD%Input(1), y_FAST%op%u_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), y_FAST%op%x_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), y_FAST%op%xd_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), y_FAST%op%z_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), y_FAST%op%OtherSt_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (FEAM%Input(1), y_FAST%op%u_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), y_FAST%op%x_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), y_FAST%op%xd_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), y_FAST%op%z_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), y_FAST%op%OtherSt_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (IceF%Input(1), y_FAST%op%u_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (IceD%x( k,STATE_CURR), y_FAST%op%x_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(k,STATE_CURR), y_FAST%op%xd_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( k,STATE_CURR), y_FAST%op%z_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (IceD%Input(1,k), y_FAST%op%u_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + +END SUBROUTINE SaveOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine takes arrays representing the eigenvector of the states and uses it to modify the operating points for +!! continuous states. It is highly tied to the module organizaton. +SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t + INTEGER(IntKi), INTENT(IN ) :: iLinTime !< index into LinTimes dimension of arrays (azimuth) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + INTEGER(IntKi) :: i, iStart ! generic loop counters + INTEGER(IntKi) :: iBody ! WAMIT body loop counter + INTEGER(IntKi) :: j ! generic loop counters + INTEGER(IntKi) :: indx ! generic loop counters + INTEGER(IntKi) :: indx_last ! generic loop counters + INTEGER(IntKi) :: i_x ! index into packed array + INTEGER(IntKi) :: nStates ! number of second-order states + INTEGER(IntKi) :: ThisModule ! identifier of current module + + CHARACTER(*), PARAMETER :: RoutineName = 'PerturbOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + i_x = 1 + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x) ! use this for the loop because ED may have a larger op_x_eig_mag array than op_x + + ! this is a hack because not all modules pack the continuous states in the same way: + if (ThisModule == Module_ED) then + if (j<= ED%p%DOFs%NActvDOF) then + indx = ED%p%DOFs%PS(j) + else + indx = ED%p%DOFs%PS(j-ED%p%DOFs%NActvDOF) + ED%p%NDOF + end if + else + indx = j + end if + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx) = p_FAST%VTK_modes%x_eig_magnitude(i_x, iLinTime, iMode) ! this is going to hold the magnitude of the eigenvector + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(indx) = p_FAST%VTK_modes%x_eig_phase( i_x, iLinTime, iMode) ! this is going to hold the phase of the eigenvector + i_x = i_x + 1; + end do + end if + + end do + end do + + + + ! ElastoDyn: + ThisModule = Module_ED + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)/2 + + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QDT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + + ! BeamDyn: + IF ( p_FAST%CompElast == Module_BD ) THEN + ThisModule = Module_BD + DO k=1,p_FAST%nBeams + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)/2 + + indx = 1 + do i=2,BD%p(k)%node_total + indx_last = indx + BD%p(k)%dof_node - 1 + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%q( :,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx:indx_last ), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase( indx:indx_last )) + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%dqdt(:,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag(nStates+indx:indx_last+nStates), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(nStates+indx:indx_last+nStates)) + indx = indx_last+1 + end do + + end if + + END DO + END IF + + + !!! ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !!!!IF ( p_FAST%CompAero == Module_AD14 ) THEN + !!!!ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + ThisModule = Module_AD + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + + indx = 1 + ! set linearization operating points: + if (AD%p%rotors(1)%BEMT%DBEMT%lin_nx>0) then + do j=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element,2) + do i=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element,1) + indx_last = indx + size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind) - 1 + call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & + y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) + indx = indx_last + 1 + end do + end do + + do j=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element,2) + do i=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element,1) + indx_last = indx + size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind_1) - 1 + call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind_1, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & + y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) + indx = indx_last + 1 + end do + end do + + end if + + if (AD%p%rotors(1)%BEMT%UA%lin_nx>0) then + do j=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element,2) + do i=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element,1) + indx_last = indx + size(AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element(i,j)%x) - 1 + call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element(i,j)%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & + y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) + indx = indx_last + 1 + end do + end do + end if + + end if + END IF + !!! + !!!! InflowWind: copy op to actual states and inputs + !!!IF ( p_FAST%CompInflow == Module_IfW ) THEN + !!!END IF + !!! + !!! + !!!! ServoDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompServo == Module_SrvD ) THEN + !!!END IF + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + ThisModule = Module_HD + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + ! WAMIT parameter and continuous states are now an arrays of length NBody + ! All Excitation states are stored first and then Radiation states. + ! We will try to loop over each of the NBody(s) and add each body's states to the overall state array + iStart = 1 + do iBody = 1, HD%p%NBody + nStates = HD%p%WAMIT(iBody)%SS_Exctn%numStates + if (nStates > 0) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT(iBody)%SS_Exctn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(iStart:iStart+nStates-1), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(iStart:iStart+nStates-1)) + iStart = iStart + nStates + end if + end do + do iBody = 1, HD%p%NBody + nStates = HD%p%WAMIT(iBody)%SS_Rdtn%numStates + if (nStates > 0) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT(iBody)%SS_Rdtn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(iStart:iStart+nStates-1), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(iStart:iStart+nStates-1)) + iStart = iStart + nStates + end if + end do + end if + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + ThisModule = Module_SD + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)/2 + call GetStateAry(p_FAST, iMode, t, SD%x( STATE_CURR)%qm, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + call GetStateAry(p_FAST, iMode, t, SD%x( STATE_CURR)%qmdot, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + END IF + +END SUBROUTINE PerturbOP +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: i !< Index into LinTimes (to determine which operating point to copy) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetOperatingPoint' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + ! ElastoDyn: copy op to actual states and inputs + CALL ED_CopyContState (y_FAST%op%x_ED( i), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (y_FAST%op%xd_ED( i), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (y_FAST%op%z_ED( i), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (y_FAST%op%OtherSt_ED( i), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (y_FAST%op%u_ED( i), ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy op to actual states and inputs + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (y_FAST%op%x_BD(k, i), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (y_FAST%op%xd_BD(k, i), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (y_FAST%op%z_BD(k, i), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (y_FAST%op%OtherSt_BD(k, i), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (y_FAST%op%u_BD(k, i), BD%Input(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (y_FAST%op%x_AD( i), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (y_FAST%op%xd_AD( i), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (y_FAST%op%z_AD( i), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (y_FAST%op%OtherSt_AD( i), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (y_FAST%op%u_AD(i), AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy op to actual states and inputs + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (y_FAST%op%x_IfW( i), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (y_FAST%op%xd_IfW( i), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (y_FAST%op%z_IfW( i), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (y_FAST%op%OtherSt_IfW( i), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (y_FAST%op%u_IfW(i), IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy op to actual states and inputs + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (y_FAST%op%x_SrvD( i), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (y_FAST%op%xd_SrvD( i), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (y_FAST%op%z_SrvD( i), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (y_FAST%op%OtherSt_SrvD( i), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (y_FAST%op%u_SrvD(i), SrvD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (y_FAST%op%x_HD( i), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (y_FAST%op%xd_HD( i), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (y_FAST%op%z_HD( i), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (y_FAST%op%OtherSt_HD( i), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (y_FAST%op%u_HD(i), HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (y_FAST%op%x_ExtPtfm(i), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (y_FAST%op%xd_ExtPtfm(i), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (y_FAST%op%z_ExtPtfm(i), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (y_FAST%op%OtherSt_ExtPtfm(i), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (y_FAST%op%u_ExtPtfm(i), ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy op to actual states and inputs + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (y_FAST%op%x_MAP(i), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (y_FAST%op%xd_MAP(i), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (y_FAST%op%z_MAP(i), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (y_FAST%op%OtherSt_MAP(i), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (y_FAST%op%u_MAP(i), MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (y_FAST%op%x_MD(i), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (y_FAST%op%xd_MD(i), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (y_FAST%op%z_MD(i), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (y_FAST%op%OtherSt_MD(i), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (y_FAST%op%u_MD(i), MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (y_FAST%op%x_FEAM(i), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (y_FAST%op%xd_FEAM(i), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (y_FAST%op%z_FEAM(i), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (y_FAST%op%OtherSt_FEAM(i), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (y_FAST%op%u_FEAM(i), FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy op to actual states and inputs + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (y_FAST%op%x_IceF(i), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (y_FAST%op%xd_IceF(i), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (y_FAST%op%z_IceF(i), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (y_FAST%op%OtherSt_IceF(i), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (y_FAST%op%u_IceF(i), IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (y_FAST%op%x_IceD(k, i), IceD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (y_FAST%op%xd_IceD(k, i), IceD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (y_FAST%op%z_IceD(k, i), IceD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (y_FAST%op%OtherSt_IceD(k, i), IceD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (y_FAST%op%u_IceD(k, i), IceD%Input(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + +END SUBROUTINE SetOperatingPoint +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine GetStateAry(p_FAST, iMode, t, x, x_eig_magnitude, x_eig_phase) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + REAL(DbKi) , INTENT(IN ) :: t !< time + REAL(R8Ki), INTENT(INOUT) :: x(:) !< in: state at its operating point; out: added perturbation + REAL(R8Ki), INTENT(IN) :: x_eig_magnitude(:) !< magnitude of the eigenvector + REAL(R8Ki), INTENT(IN) :: x_eig_phase(:) !< phase of the eigenvector + + ! note that this assumes p_FAST%VTK_modes%VTKLinPhase is zero for VTKLinTim=2 + x = x + x_eig_magnitude * p_FAST%VTK_modes%VTKLinScale * cos( TwoPi_D * p_FAST%VTK_modes%DampedFreq_Hz(iMode)*t + x_eig_phase + p_FAST%VTK_modes%VTKLinPhase ) +end subroutine GetStateAry + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the algorithm for computing a periodic steady-state solution. +SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step + REAL(DbKi), INTENT(IN ) :: t_global ! current simulation time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: DeltaAzim + REAL(DbKi) :: psi !< psi (rotor azimuth) at which the outputs are defined + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + LOGICAL :: NextAzimuth + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CalcSteady' + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! get azimuth angle + + psi = ED%y%LSSTipPxa + call Zero2TwoPi( psi ) + + if (n_t_global == 0) then + ! initialize a few things on the first call: + call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + else + DeltaAzim = psi - m_FAST%Lin%Psi(1) + call Zero2TwoPi(DeltaAzim) + + if (DeltaAzim > p_FAST%AzimDelta) then + call SetErrStat(ErrID_Fatal, "The rotor is spinning too fast. The time step or NLinTimes is too large when CalcSteady=true.", ErrStat, ErrMsg, RoutineName) + return + end if + + ! save the outputs and azimuth angle for possible interpolation later + call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + if (ErrStat >= AbortErrLev) return + + + + if ( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) <= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) ) then ! the equal sign takes care of the zero-rpm case + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) + else + ! this is the 2pi boundary, so we are either larger than the last target azimuth or less than the next one + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) .and. psi < m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) + end if + + ! Forcing linearization if it's the last step + if (t_global >= p_FAST%TMax - 0.5_DbKi*p_FAST%DT) then + call WrScr('') + call WrScr('[WARNING] Steady state not found before end of simulation. Forcing linearization.') + m_FAST%Lin%ForceLin = .True. + m_FAST%Lin%AzimIndx = 1 + NextAzimuth = .True. + endif + + if (NextAzimuth) then + + ! interpolate to find y at the target azimuth + call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + ! If linearization is forced + if (m_FAST%Lin%ForceLin) then + m_FAST%Lin%IsConverged = .True. + endif + + if (m_FAST%Lin%IsConverged .or. m_FAST%Lin%n_rot == 0) then ! save this operating point for linearization later + m_FAST%Lin%LinTimes(m_FAST%Lin%AzimIndx) = t_global + call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + end if + + ! increment the counter to check the next azimuth: + m_FAST%Lin%AzimIndx = m_FAST%Lin%AzimIndx + 1 + + ! check if we've completed one rotor revolution + if (m_FAST%Lin%AzimIndx > p_FAST%NLinTimes) then + m_FAST%Lin%n_rot = m_FAST%Lin%n_rot + 1 + + m_FAST%Lin%FoundSteady = m_FAST%Lin%IsConverged + + if (.not. m_FAST%Lin%FoundSteady) then + ! compute the reference values for this rotor revolution + call ComputeOutputRanges(p_FAST, y_FAST, m_FAST, SrvD%y) + m_FAST%Lin%IsConverged = .true. ! check errors next rotor revolution + m_FAST%Lin%AzimIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY + end if + ! Forcing linearization if time is close to tmax (with sufficient margin) + if (.not.m_FAST%Lin%FoundSteady) then + if (ED%p%RotSpeed>0) then + ! If simulation is at least 10 revolutions, and error in rotor speed less than 0.1% + if ((p_FAST%TMax>10*(TwoPi_D)/ED%p%RotSpeed) .and. ( t_global >= p_FAST%TMax - 2._DbKi*(TwoPi_D)/ED%p%RotSpeed)) then + if (abs(ED%y%RotSpeed-ED%p%RotSpeed)/ED%p%RotSpeed<0.001) then + call WrScr('') + call WrScr('[WARNING] Steady state not found before end of simulation. Forcing linearization.') + m_FAST%Lin%ForceLin = .True. + endif + endif + else + if (t_global >= p_FAST%TMax - 1.5_DbKi*p_FAST%DT) then + call WrScr('') + call WrScr('[WARNING] Steady state not found before end of simulation. Forcing linearization.') + m_FAST%Lin%ForceLin = .True. + endif + endif + endif + end if + + end if + if (m_FAST%Lin%ForceLin) then + m_FAST%Lin%IsConverged=.true. + m_FAST%Lin%FoundSteady=.true. + endif + + +END SUBROUTINE FAST_CalcSteady +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes variables for calculating periodic steady-state solution. +SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitSteadyOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + do j=1,p_FAST%NLinTimes + m_FAST%Lin%AzimTarget(j) = (j-1) * p_FAST%AzimDelta + psi + call Zero2TwoPi( m_FAST%Lin%AzimTarget(j) ) + end do + ! this is circular, so I am going to add points at the beginning and end to avoid + ! more IF statements later + m_FAST%Lin%AzimTarget(0) = m_FAST%Lin%AzimTarget(p_FAST%NLinTimes) + m_FAST%Lin%AzimTarget(p_FAST%NLinTimes+1) = m_FAST%Lin%AzimTarget(1) + + + ! Azimuth angles that correspond to Output arrays for interpolation: + !m_FAST%Lin%Psi = psi ! initialize entire array (note that we won't be able to interpolate with a constant array + DO j = 1, p_FAST%LinInterpOrder + 1 + m_FAST%Lin%Psi(j) = psi - (j - 1) * D2R_D ! arbitrarily say azimuth is one degree different + END DO + + + ! ElastoDyn + allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + do j = 1, p_FAST%LinInterpOrder + 1 + call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end do + + allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end if + + end if + + END IF ! BeamDyn + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + allocate( AD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating AD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call AD_CopyOutput(AD%y, AD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call AD_CopyOutput(AD%y, AD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + allocate( IfW%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating IfW%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call InflowWind_CopyOutput(IfW%y, IfW%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call InflowWind_CopyOutput(IfW%y, IfW%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + allocate( SrvD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SrvD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SrvD_CopyOutput(SrvD%y, SrvD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SrvD_CopyOutput(SrvD%y, SrvD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + allocate( HD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating HD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call HydroDyn_CopyOutput(HD%y, HD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call HydroDyn_CopyOutput(HD%y, HD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! HydroDyn + + !! SubDyn/ExtPtfm_MCKF + IF ( p_FAST%CompSub == Module_SD ) THEN + allocate( SD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SD_CopyOutput(SD%y, SD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SD_CopyOutput(SD%y, SD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + allocate( MAPp%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating MAPp%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call MAP_CopyOutput(MAPp%y, MAPp%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call MAP_CopyOutput(MAPp%y, MAPp%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + allocate( MD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating MD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call MD_CopyOutput(MD%y, MD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call MD_CopyOutput(MD%y, MD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + + + + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_InitSteadyOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine saves outputs for future interpolation at a desired azimuth. +SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SaveOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + DO j = p_FAST%LinInterpOrder, 1, -1 + m_FAST%Lin%Psi(j+1) = m_FAST%Lin%Psi(j) + END DO + + if (psi < m_FAST%Lin%Psi(1)) then + ! if we go around a 2pi boundary, we will subtract 2pi from the saved values so that interpolation works as expected + m_FAST%Lin%Psi = m_FAST%Lin%Psi - TwoPi_D + end if + m_FAST%Lin%Psi(1) = psi + + ! ElastoDyn + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL AD_CopyOutput (AD%Output(j), AD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL AD_CopyOutput (AD%y, AD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL InflowWind_CopyOutput (IfW%Output(j), IfW%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL InflowWind_CopyOutput (IfW%y, IfW%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL SrvD_CopyOutput (SrvD%Output(j), SrvD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL SrvD_CopyOutput (SrvD%y, SrvD%Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + + CALL HydroDyn_CopyOutput (HD%Output(j), HD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL HydroDyn_CopyOutput (HD%y, HD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! HydroDyn + + !! SubDyn/ExtPtfm_MCKF + IF ( p_FAST%CompSub == Module_SD ) THEN + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL SD_CopyOutput (SD%Output(j), SD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL SD_CopyOutput (SD%y, SD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MAP_CopyOutput (MAPp%Output(j), MAPp%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL MAP_CopyOutput (MAPp%y, MAPp%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MD_CopyOutput (MD%Output(j), MD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL MD_CopyOutput (MD%y, MD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_SaveOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores +!! them for future rotation . +SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi_target !< psi (rotor azimuth) at which the outputs are requested + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(DbKi) :: t_global + REAL(ReKi) :: eps_squared + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DiffInterpOutputs' + + ErrStat = ErrID_None + ErrMsg = "" + t_global = 0.0_DbKi ! we don't really need this to get the output OPs + + !................................................................................................ + ! Extrapolate outputs to the target azimuth and pack into OP arrays + !................................................................................................ + + ! ElastoDyn + CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + CALL AD_Output_ExtrapInterp (AD%Output, m_FAST%Lin%Psi, AD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), & + AD%y_interp, AD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + CALL InflowWind_Output_ExtrapInterp (IfW%Output, m_FAST%Lin%Psi, IfW%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & + IfW%y_interp, IfW%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + CALL SrvD_Output_ExtrapInterp (SrvD%Output, m_FAST%Lin%Psi, SrvD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & + SrvD%y_interp, SrvD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + CALL HydroDyn_Output_ExtrapInterp (HD%Output, m_FAST%Lin%Psi, HD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y_interp, HD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + IF ( p_FAST%CompSub == Module_SD ) THEN + + CALL SD_Output_ExtrapInterp (SD%Output, m_FAST%Lin%Psi, SD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SD_GetOP( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), & + SD%y_interp, SD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + CALL MAP_Output_ExtrapInterp (MAPp%Output, m_FAST%Lin%Psi, MAPp%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y_interp, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + CALL MD_Output_ExtrapInterp (MD%Output, m_FAST%Lin%Psi, MD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call MD_GetOP( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & + MD%y_interp, MD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + + call pack_in_array(p_FAST, y_FAST, m_FAST) + + if (m_FAST%Lin%IsConverged) then + ! check that error equation is less than TrimTol !!!call + call calc_error(p_FAST, y_FAST, m_FAST, SrvD%y, eps_squared) + m_FAST%Lin%IsConverged = eps_squared < p_FAST%TrimTol + end if + + + m_FAST%Lin%Y_prevRot(:,m_FAST%Lin%AzimIndx) = m_FAST%Lin%y_interp + +END SUBROUTINE FAST_DiffInterpOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE pack_in_array(p_FAST, y_FAST, m_FAST) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + m_FAST%Lin%y_interp( indx ) = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%op_y(j) + end do + + end do + end do + +END SUBROUTINE pack_in_array +!---------------------------------------------------------------------------------------------------------------------------------- +!> This function computes the error function between this rotor revolution and the previous one. +!! Angles represented in m_FAST%Lin%y_interp may have 2pi added or subtracted to allow the angles to be closer to the previous +!! rotor revolution. +SUBROUTINE calc_error(p_FAST, y_FAST, m_FAST, y_SrvD, eps_squared) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + REAL(ReKi) ,INTENT( OUT) :: eps_squared !< epsilon squared + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + real(ReKi) :: diff + + + ! special cases for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + end do + end if + + + ! compute the error: + eps_squared = 0.0_ReKi + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + if (EqualRealNos(m_FAST%Lin%y_interp( indx ), m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ))) then + diff = 0.0_ReKi ! take care of some potential numerical issues + else + diff = m_FAST%Lin%y_interp( indx ) - m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ) + end if + + eps_squared = eps_squared + ( diff / m_FAST%Lin%y_ref( indx ) ) ** 2 + end do + + end do + end do + + + !................................. + ! Normalize: + !................................. + eps_squared = eps_squared / ( y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Glue%NumOutputs ) + +! write(50+m_FAST%Lin%AzimIndx,'(3000(F15.7,1x))') m_FAST%Lin%y_interp, eps_squared +END SUBROUTINE calc_error +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ComputeOutputRanges(p_FAST, y_FAST, m_FAST, y_SrvD) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + + integer :: indx + integer :: i + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) + m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) + m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) +! if (m_FAST%Lin%y_ref(indx) < 1.0e-4) m_FAST%Lin%y_ref(indx) = 1.0_ReKi ! not sure why we wouldn't just do m_FAST%Lin%y_ref(indx) = max(1.0_ReKi, m_FAST%Lin%y_ref(indx)) or max(1e-4, y_ref(indx)) + end do + + ! special case for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + end do + end if + + ! Note: I'm ignoring the periodicity of the log maps that represent orientations + +END SUBROUTINE ComputeOutputRanges +!---------------------------------------------------------------------------------------------------------------------------------- + +END MODULE FAST_Linear diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 649b1528e5..a9a2c6fdba 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -88,6 +88,66 @@ typedef ^ FAST_VTK_ModeShapeType R8Ki DampedFreq_Hz {:} - - typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - "magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +# ..... Tight Coupling Generalized Alpha Solver Data ............. + +# Parameters +typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - +typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - +typedef ^ ^ IntKi NumCrctn - - - "" - +typedef ^ ^ IntKi MaxConvIter - - - "" - +typedef ^ ^ IntKi NIter_UJac - - - "Number of solution iterations between updating the Jacobian" - +typedef ^ ^ IntKi NStep_UJac - - - "Number of global time steps between updating the Jacobian" - +typedef ^ ^ R8Ki Scale_UJac - - - "" - +typedef ^ ^ R8Ki AccBlend - 1 - "" - +typedef ^ ^ R8Ki RhoInf - - - "Rho infinity used for calculating Generalized-alpha coefficients" - +typedef ^ ^ R8Ki AlphaM - - - "Generalized-alpha alpha_m coefficient" - +typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - +typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - +typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - +typedef ^ ^ R8Ki C 3 - - "Generalized-alpha coefficient array" - +typedef ^ ^ IntKi iX1Tight : - - "" - +typedef ^ ^ IntKi iX2Tight : - - "" - +typedef ^ ^ IntKi iUTight : - - "" - +typedef ^ ^ IntKi iUOpt1 : - - "" - +typedef ^ ^ IntKi iyTight : - - "" - +typedef ^ ^ IntKi iyOpt1 : - - "" - +typedef ^ ^ IntKi ixqd :: - - "" - +typedef ^ ^ IntKi iJX2 : - - "Indices of Jacobian q variables" - +typedef ^ ^ IntKi iJT : - - "Indices of Jacobian tight coupling variables" - +typedef ^ ^ IntKi iJ1 : - - "Indices of Jacobian option 1 variables" - +typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - +typedef ^ ^ IntKi iModAll : - - "ModData index order for all modules" - +typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - +typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - +typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - +typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - + +# Misc/Optimization variables +typedef ^ TC_MiscVarType R8Ki q :: - - "" - +typedef ^ ^ R8Ki qn :: - - "" - +typedef ^ ^ R8Ki x : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki un : - - "" - +typedef ^ ^ R8Ki u_tmp : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - +typedef ^ ^ R8Ki dUdu :: - - "" - +typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ R8Ki Jac :: - - "" - +typedef ^ ^ IntKi IPIV : - - "" - +typedef ^ ^ IntKi IterTotal - 0 - "" - +typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ R8Ki dq :: - - "Change in q" - +typedef ^ ^ R8Ki dx : - - "Change in x" - +typedef ^ ^ R8Ki du : - - "" - + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: @@ -196,6 +256,7 @@ typedef ^ FAST_ParameterType IntKi Lin_NumMods - - - "number of modules in the l typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - #typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - +typedef ^ FAST_ParameterType TC_ParameterType Solver - - - "Tight Coupling Solver Parameters" - # SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) @@ -384,6 +445,7 @@ typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Arr # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] # note that I'm making the allocatable-for-instance-used part INSIDE the data type (as opposed to an array of IceDyn_Data types) because I want to pass arrays of x, xd, z, x_pred, etc) typedef FAST BeamDyn_Data BD_ContinuousStateType x {:}{:} - - "Continuous states" +typedef ^ ^ BD_ContinuousStateType dxdt {:} - - "Continuous state derivatives" typedef ^ ^ BD_DiscreteStateType xd {:}{:} - - "Discrete states" typedef ^ ^ BD_ConstraintStateType z {:}{:} - - "Constraint states" typedef ^ ^ BD_OtherStateType OtherSt {:}{:} - - "Other states" @@ -398,6 +460,7 @@ typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Arr # ..... ElastoDyn data ....................................................................................................... typedef FAST ElastoDyn_Data ED_ContinuousStateType x {2} - - "Continuous states" +typedef ^ ^ ED_ContinuousStateType dxdt - - - "Continuous state derivatives" typedef ^ ^ ED_DiscreteStateType xd {2} - - "Discrete states" typedef ^ ^ ED_ConstraintStateType z {2} - - "Constraint states" typedef ^ ^ ED_OtherStateType OtherSt {2} - - "Other states" @@ -478,6 +541,7 @@ typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... typedef FAST SubDyn_Data SD_ContinuousStateType x {2} - - "Continuous states" +typedef ^ ^ SD_ContinuousStateType dxdt - - - "Continuous state derivatives" typedef ^ ^ SD_DiscreteStateType xd {2} - - "Discrete states" typedef ^ ^ SD_ConstraintStateType z {2} - - "Constraint states" typedef ^ ^ SD_OtherStateType OtherSt {2} - - "Other states" @@ -697,6 +761,8 @@ typedef ^ FAST_MiscVarType INTEGER SimStrtTime {8} - - "Start time of simulation typedef ^ FAST_MiscVarType Logical calcJacobian - - - "Should we calculate Jacobians in Option 1?" (flag) typedef ^ FAST_MiscVarType FAST_ExternInputType ExternInput - - - "external input values" - typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearization analysis" - +typedef ^ FAST_MiscVarType ModDataType Modules {:} - - "module variable and value data" - +typedef ^ FAST_MiscVarType TC_MiscVarType Solver - - - "Tight coupling solver Miscellaneous variables" - # ..... FAST_InitData data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 new file mode 100644 index 0000000000..958e7ee227 --- /dev/null +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -0,0 +1,7923 @@ +!********************************************************************************************************************************** +! FAST_Solver.f90, FAST_Subs.f90, FAST_Lin.f90, and FAST_Mods.f90 make up the FAST glue code in the FAST Modularization Framework. +! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +MODULE FAST_Subs + + USE FAST_Solver + USE FAST_Linear + USE SC_DataEx + USE VersionInfo + + IMPLICIT NONE + +CONTAINS +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! INITIALIZATION ROUTINES +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> a wrapper routine to call FAST_Initialize at the full-turbine simulation level (makes easier to write top-level driver) +SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: TurbID !< turbine Identifier (1-NumTurbines) + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL,INTENT(IN ) :: InFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) + TYPE(FAST_ExternInitType),OPTIONAL,INTENT(IN ) :: ExternInitData !< Initialization input data from an external source (Simulink) + + Turbine%TurbID = TurbID + + + IF (PRESENT(InFile)) THEN + IF (PRESENT(ExternInitData)) THEN + CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + ELSE + CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile ) + END IF + ELSE + CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + END IF + + +END SUBROUTINE FAST_InitializeAll_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to call Init routine for each module. This routine sets all of the init input data for each module. +SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + + use ElastoDyn_Parameters, only: Method_RK4 + USE Solver, only: Solver_Init + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< SuperController exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT(IN ) :: InFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) + + TYPE(FAST_ExternInitType), OPTIONAL, INTENT(IN) :: ExternInitData !< Initialization input data from an external source (Simulink) + + ! local variables + CHARACTER(1024) :: InputFile !< A CHARACTER string containing the name of the primary FAST input file + TYPE(FAST_InitData) :: Init !< Initialization data for all modules + + + REAL(ReKi) :: AirDens ! air density for initialization/normalization of OpenFOAM data + REAL(DbKi) :: dt_IceD ! tmp dt variable to ensure IceDyn doesn't specify different dt values for different legs (IceDyn instances) + REAL(DbKi) :: dt_BD ! tmp dt variable to ensure BeamDyn doesn't specify different dt values for different instances + INTEGER(IntKi) :: ErrStat2 + INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances + INTEGER(IntKi) :: I ! generic loop counter + INTEGER(IntKi) :: k ! blade loop counter + INTEGER(IntKi) :: nNodes ! temp var for OpFM coupling + logical :: CallStart + + + INTEGER(IntKi) :: NumBl + + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitializeAll' + + + !.......... + ErrStat = ErrID_None + ErrMsg = "" + + y_FAST%UnSum = -1 ! set the summary file unit to -1 to indicate it's not open + y_FAST%UnOu = -1 ! set the text output file unit to -1 to indicate it's not open + y_FAST%UnGra = -1 ! set the binary graphics output file unit to -1 to indicate it's not open + + p_FAST%WrVTK = VTK_Unknown ! set this so that we can potentially output VTK information on initialization error + p_FAST%VTK_tWidth = 1 ! initialize in case of error before reading the full file + p_FAST%n_VTKTime = 1 ! initialize in case of error before reading the full file + y_FAST%VTK_LastWaveIndx = 1 ! Start looking for wave data at the first index + y_FAST%VTK_count = 0 ! first VTK file has 0 as output + y_FAST%n_Out = 0 ! set the number of ouptut channels to 0 to indicate there's nothing to write to the binary file + p_FAST%ModuleInitialized = .FALSE. ! (array initialization) no modules are initialized + + ! Get the current time + CALL DATE_AND_TIME ( Values=m_FAST%StrtTime ) ! Let's time the whole simulation + CALL CPU_TIME ( m_FAST%UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) + m_FAST%UsrTime1 = MAX( 0.0_ReKi, m_FAST%UsrTime1 ) ! CPU_TIME: If a meaningful time cannot be returned, a processor-dependent negative value is returned + + + m_FAST%t_global = t_initial - 20. ! initialize this to a number < t_initial for error message in ProgAbort + m_FAST%calcJacobian = .TRUE. ! we need to calculate the Jacobian + m_FAST%NextJacCalcTime = m_FAST%t_global ! We want to calculate the Jacobian on the first step + p_FAST%TDesc = '' +! p_FAST%CheckHSSBrTrqC = .false. + + y_FAST%Lin%WindSpeed = 0.0_ReKi + + if (present(ExternInitData)) then + CallStart = .not. ExternInitData%FarmIntegration ! .and. ExternInitData%TurbineID == 1 + if (ExternInitData%TurbineID > 0) p_FAST%TDesc = 'T'//trim(num2lstr(ExternInitData%TurbineID)) + else + CallStart = .true. + end if + + + ! Init NWTC_Library, display copyright and version information: + if (CallStart) then + AbortErrLev = ErrID_Fatal ! Until we read otherwise from the FAST input file, we abort only on FATAL errors + CALL FAST_ProgStart( FAST_Ver ) + p_FAST%WrSttsTime = .TRUE. + else + ! if we don't call the start data (e.g., from FAST.Farm), we won't override AbortErrLev either + CALL DispNVD( FAST_Ver ) + p_FAST%WrSttsTime = .FALSE. + end if + + IF (PRESENT(InFile)) THEN + p_FAST%UseDWM = .FALSE. + InputFile = InFile + ELSE + CALL GetInputFileName(InputFile,p_FAST%UseDWM,ErrStat2,ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + END IF + + ! ... Open and read input files ... + ! also, set applicable farm paramters and turbine reference position also for graphics output + p_FAST%UseSC = .FALSE. + if (PRESENT(ExternInitData)) then + p_FAST%FarmIntegration = ExternInitData%FarmIntegration + p_FAST%TurbinePos = ExternInitData%TurbinePos + p_FAST%WaveFieldMod = ExternInitData%WaveFieldMod + if( (ExternInitData%NumSC2CtrlGlob .gt. 0) .or. (ExternInitData%NumSC2Ctrl .gt. 0) .or. (ExternInitData%NumCtrl2SC .gt. 0)) then + p_FAST%UseSC = .TRUE. + end if + + if (ExternInitData%FarmIntegration) then ! we're integrating with FAST.Farm + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) + else + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) + end if + + else + p_FAST%TurbinePos = 0.0_ReKi + p_FAST%WaveFieldMod = 0 + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) + end if + + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + + !............................................................................................................................... + + p_FAST%dt_module = p_FAST%dt ! initialize time steps for each module + + ! ........................ + ! initialize ElastoDyn (must be done first) + ! ........................ + + ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + Init%InData_ED%Linearize = p_FAST%Linearize + Init%InData_ED%InputFile = p_FAST%EDFile + IF ( p_FAST%CompAero == Module_AD14 ) THEN + Init%InData_ED%ADInputFile = p_FAST%AeroFile + ELSE + Init%InData_ED%ADInputFile = "" + END IF + + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) + Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED + + Init%InData_ED%Gravity = p_FAST%Gravity + + Init%InData_ED%MHK = p_FAST%MHK + Init%InData_ED%WtrDpth = p_FAST%WtrDpth + + CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_ED) = .TRUE. + CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! bjj: added this check per jmj; perhaps it would be better in ElastoDyn, but I'll leave it here for now: + IF ( p_FAST%TurbineType == Type_Offshore_Floating ) THEN + IF ( ED%p%TowerBsHt < 0.0_ReKi .AND. .NOT. EqualRealNos( ED%p%TowerBsHt, 0.0_ReKi ) ) THEN + CALL SetErrStat(ErrID_Fatal,"ElastoDyn TowerBsHt must not be negative for floating offshore systems.",ErrStat,ErrMsg,RoutineName) + END IF + END IF + + allocate( y_FAST%Lin%Modules(MODULE_ED)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) + else + + if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) + if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) + if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) + if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + NumBl = Init%OutData_ED%NumBl + + ! Add module to array of modules + call MV_AddModule(m_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), & + Init%OutData_ED%Vars, Init%OutData_ED%Vals) + + if (p_FAST%CalcSteady) then + if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then + p_FAST%TrimCase = TrimCase_none + p_FAST%NLinTimes = 1 + p_FAST%LinInterpOrder = 0 ! constant values + elseif ( Init%OutData_ED%isFixed_GenDOF ) then + p_FAST%TrimCase = TrimCase_none + end if + end if + + + ! ........................ + ! initialize BeamDyn + ! ........................ + IF ( p_FAST%CompElast == Module_BD ) THEN + p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + ELSE + p_FAST%nBeams = 0 + END IF + + ALLOCATE( BD%Input( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input and BD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( BD%x( p_FAST%nBeams,2), & + BD%xd( p_FAST%nBeams,2), & + BD%z( p_FAST%nBeams,2), & + BD%OtherSt( p_FAST%nBeams,2), & + BD%p( p_FAST%nBeams ), & + BD%u( p_FAST%nBeams ), & + BD%y( p_FAST%nBeams ), & + BD%m( p_FAST%nBeams ), & + Init%OutData_BD(p_FAST%nBeams ), & + STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating BeamDyn state, input, and output data.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF (p_FAST%CompElast == Module_BD) THEN + + Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + + Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration" m/s^2 + + ! now initialize BeamDyn for all beams + dt_BD = p_FAST%dt_module( MODULE_BD ) + + Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) + + p_FAST%BD_OutputSibling = .true. + + allocate( y_FAST%Lin%Modules(MODULE_BD)%Instance(p_FAST%nBeams), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(BD).", ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + end if + + DO k=1,p_FAST%nBeams + Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) + + + Init%InData_BD%InputFile = p_FAST%BDBldFile(k) + + Init%InData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" + Init%InData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + + Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + + CALL BD_Init( Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, Init%OutData_BD(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n BD modules with n timesteps. + IF ( k == 1 ) THEN + p_FAST%dt_module( MODULE_BD ) = dt_BD + + p_FAST%ModuleInitialized(Module_BD) = .TRUE. ! this really should be once per BD instance, but BD doesn't care so I won't go through the effort to track this + CALL SetModuleSubstepTime(Module_BD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ELSEIF ( .NOT. EqualRealNos( p_FAST%dt_module( MODULE_BD ),dt_BD )) THEN + CALL SetErrStat(ErrID_Fatal,"All instances of BeamDyn (one per blade) must have the same time step.",ErrStat,ErrMsg,RoutineName) + END IF + + ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings: + if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. + + if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors + + if (size(y_FAST%Lin%Modules(MODULE_BD)%Instance) >= k) then ! for aero maps, we only use the first instance: + if (allocated(Init%OutData_BD(k)%LinNames_y)) call move_alloc(Init%OutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) + if (allocated(Init%OutData_BD(k)%LinNames_x)) call move_alloc(Init%OutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) + if (allocated(Init%OutData_BD(k)%LinNames_u)) call move_alloc(Init%OutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) + if (allocated(Init%OutData_BD(k)%RotFrame_y)) call move_alloc(Init%OutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) + if (allocated(Init%OutData_BD(k)%RotFrame_x)) call move_alloc(Init%OutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) + if (allocated(Init%OutData_BD(k)%RotFrame_u)) call move_alloc(Init%OutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) + if (allocated(Init%OutData_BD(k)%IsLoad_u )) call move_alloc(Init%OutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) + if (allocated(Init%OutData_BD(k)%DerivOrder_x)) call move_alloc(Init%OutData_BD(k)%DerivOrder_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) + + if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) + end if + + END DO + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + + END IF + + + ! ........................ + ! initialize AeroDyn + ! ........................ + ALLOCATE( AD14%Input( p_FAST%InterpOrder+1 ), AD14%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input and AD14%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + + CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + CALL AD14_Init( Init%InData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & + AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), Init%OutData_AD14, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_AD14) = .TRUE. + CALL SetModuleSubstepTime(Module_AD14, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! bjj: this really shouldn't be in the FAST glue code, but I'm going to put this check here so people don't use an invalid model + ! and send me emails to debug numerical issues in their results. + IF ( AD14%p%TwrProps%PJM_Version .AND. p_FAST%TurbineType == Type_Offshore_Floating ) THEN + CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 tower influence model "NEWTOWER" is invalid for models of floating offshore turbines.',ErrStat,ErrMsg,RoutineName) + END IF + + AirDens = Init%OutData_AD14%AirDens + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + + allocate(Init%InData_AD%rotors(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) + call Cleanup() + return + end if + + Init%InData_AD%rotors(1)%NumBlades = NumBl + + ! set initialization data for AD + CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%BladeRootPosition', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%BladeRootOrientation', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + Init%InData_AD%Gravity = p_FAST%Gravity + Init%InData_AD%Linearize = p_FAST%Linearize + Init%InData_AD%InputFile = p_FAST%AeroFile + Init%InData_AD%RootName = p_FAST%OutFileRoot + Init%InData_AD%MHK = p_FAST%MHK + if ( p_FAST%MHK == 0 ) then + Init%InData_AD%defFldDens = p_FAST%AirDens + elseif ( p_FAST%MHK == 1 .or. p_FAST%MHK == 2 ) then + Init%InData_AD%defFldDens = p_FAST%WtrDens + end if + Init%InData_AD%defKinVisc = p_FAST%KinVisc + Init%InData_AD%defSpdSound = p_FAST%SpdSound + Init%InData_AD%defPatm = p_FAST%Patm + Init%InData_AD%defPvap = p_FAST%Pvap + Init%InData_AD%WtrDpth = p_FAST%WtrDpth + Init%InData_AD%MSL2SWL = p_FAST%MSL2SWL + + + Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) + Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + ! Note: not passing tailfin position and orientation at init + Init%InData_AD%rotors(1)%AeroProjMod = APM_BEM_NoSweepPitchTwist + + do k=1,NumBl + Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + end do + + CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_AD) = .TRUE. + CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_AD%rotors(1)%LinNames_u )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_AD%rotors(1)%LinNames_y )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_AD%rotors(1)%LinNames_x )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_x ) + if (allocated(Init%OutData_AD%rotors(1)%RotFrame_u )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_AD%rotors(1)%RotFrame_y )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_AD%rotors(1)%RotFrame_x )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_x ) + if (allocated(Init%OutData_AD%rotors(1)%IsLoad_u )) call move_alloc(Init%OutData_AD%rotors(1)%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_AD%rotors(1)%DerivOrder_x)) call move_alloc(Init%OutData_AD%rotors(1)%DerivOrder_x,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%DerivOrder_x ) + + if (allocated(Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%rotors(1)%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + AirDens = Init%OutData_AD%rotors(1)%AirDens + + ELSE + AirDens = 0.0_ReKi + END IF ! CompAero + + + ! ........................ + ! initialize InflowWind + ! ........................ + ALLOCATE( IfW%Input( p_FAST%InterpOrder+1 ), IfW%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input and IfW%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + Init%InData_IfW%Linearize = p_FAST%Linearize + Init%InData_IfW%InputFileName = p_FAST%InflowFile + Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) + Init%InData_IfW%UseInputFile = .TRUE. + Init%InData_IfW%FixedWindFileRootName = .FALSE. + Init%InData_IfW%OutputAccel = p_FAST%MHK > 0 + + Init%InData_IfW%MHK = p_FAST%MHK + Init%InData_IfW%WtrDpth = p_FAST%WtrDpth + + Init%InData_IfW%NumWindPoints = 0 + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 + END IF + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes + ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ! Number of Wind points from AeroDyn, see AeroDyn.f90 + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD_NumWindPoints(AD%Input(1), AD%OtherSt(STATE_CURR)) + ! Wake -- we allow the wake positions to exceed the wind box + if (allocated(AD%OtherSt(STATE_CURR)%WakeLocationPoints)) then + Init%InData_IfW%BoxExceedAllowF = .true. + Init%InData_IfW%BoxExceedAllowIdx = min(Init%InData_IfW%BoxExceedAllowIdx, AD_BoxExceedPointsIdx(AD%Input(1), AD%OtherSt(STATE_CURR))) + endif + END IF + + ! lidar + Init%InData_IfW%lidar%Tmax = p_FAST%TMax + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + if ( p_FAST%CompElast == Module_BD ) then + Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) + else + Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength + end if + + IF ( PRESENT(ExternInitData) ) THEN + Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration + + if (Init%InData_IfW%Use4Dext) then + Init%InData_IfW%FDext%n = ExternInitData%windGrid_n + Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta + Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero + Init%InData_IfW%FDext%Vel => ExternInitData%windGrid_data + end if + ELSE + Init%InData_IfW%Use4Dext = .false. + END IF + + CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_IfW) = .TRUE. + CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Set pointers to flowfield + IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => IfW%p%FlowField + + allocate( y_FAST%Lin%Modules(MODULE_IfW)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) + if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) + if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN !assign the number of gates to ServD + if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed + endif + if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX + endif + if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY + endif + if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ + endif + Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType + Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam + Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate + Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing + END IF + + + ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN + + IF ( PRESENT(ExternInitData) ) THEN + Init%InData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower + ELSE + CALL SetErrStat( ErrID_Fatal, 'OpenFOAM integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + END IF + ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics + Init%InData_OpFM%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) + if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then + Init%InData_OpFM%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node + Init%InData_OpFM%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) + ALLOCATE(Init%InData_OpFM%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) + Init%InData_OpFM%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) + else + Init%InData_OpFM%TowerHeight = 0.0_ReKi + Init%InData_OpFM%TowerBaseHeight = 0.0_ReKi + endif + ALLOCATE(Init%InData_OpFM%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) + Init%InData_OpFM%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating OpFM%InitInput.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + !Set node clustering type + Init%InData_OpFM%NodeClusterType = ExternInitData%NodeClusterType + ! set up the data structures for integration with OpenFOAM + CALL Init_OpFM( Init%InData_OpFM, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, OpFM, Init%OutData_OpFM, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + !bjj: fix me!!! to do + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi + + ELSE + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi + END IF ! CompInflow + + ! ........................ + ! initialize SuperController + ! ........................ + IF ( PRESENT(ExternInitData) ) THEN + ! set up the data structures for integration with supercontroller + IF ( p_FAST%UseSC ) THEN + CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE + SC_DX%u%c_obj%toSC_Len = 0 + SC_DX%u%c_obj%toSC = C_NULL_PTR + SC_DX%y%c_obj%fromSC_Len = 0 + SC_DX%y%c_obj%fromSC = C_NULL_PTR + SC_DX%y%c_obj%fromSCglob_Len = 0 + SC_DX%y%c_obj%fromSCglob = C_NULL_PTR + END IF + END IF + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ! ........................ + ! some checks for AeroDyn14's Dynamic Inflow with Mean Wind Speed from InflowWind: + ! (DO NOT COPY THIS CODE!) + ! bjj: AeroDyn14 should not need this rule of thumb; it should check the instantaneous values when the code runs + ! ........................ + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + IF (AD14%p%DynInfl) THEN + IF ( Init%OutData_IfW%WindFileInfo%MWS < 8.0 ) THEN + CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with wind speeds less than 8 m/s.',ErrStat,ErrMsg,RoutineName) + !CALL SetErrStat(ErrID_Info,'Estimated average inflow wind speed is less than 8 m/s. Dynamic Inflow will be turned off.',ErrStat,ErrMess,RoutineName ) + END IF + END IF + END IF + + + ! ........................ + ! set some VTK parameters required before HydroDyn init (so we can get wave elevations for visualization) + ! ........................ + + ! get wave elevation data for visualization + if ( p_FAST%WrVTK > VTK_None ) then + call SetVTKParameters_B4SeaSt(p_FAST, Init%OutData_ED, Init%InData_SeaSt, BD, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + end if + + ! ........................ + ! initialize SeaStates + ! ........................ + ALLOCATE( SeaSt%Input( p_FAST%InterpOrder+1 ), SeaSt%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input and SeaSt%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + + Init%InData_SeaSt%Gravity = p_FAST%Gravity + Init%InData_SeaSt%defWtrDens = p_FAST%WtrDens + Init%InData_SeaSt%defWtrDpth = p_FAST%WtrDpth + Init%InData_SeaSt%defMSL2SWL = p_FAST%MSL2SWL + Init%InData_SeaSt%UseInputFile = .TRUE. + Init%InData_SeaSt%Linearize = p_FAST%Linearize + Init%InData_SeaSt%hasIce = p_FAST%CompIce /= Module_None + Init%InData_SeaSt%InputFile = p_FAST%SeaStFile + Init%InData_SeaSt%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SeaSt)) + + ! these values support wave field handling + Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod + Init%InData_SeaSt%PtfmLocationX = p_FAST%TurbinePos(1) + Init%InData_SeaSt%PtfmLocationY = p_FAST%TurbinePos(2) + + Init%InData_SeaSt%TMax = p_FAST%TMax + + CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. + CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup + if ( p_FAST%CompHydro == Module_HD ) then + Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave + Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 + Init%InData_HD%RhoXg = Init%OutData_SeaSt%RhoXg + Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod + Init%InData_HD%WaveStMod = Init%OutData_SeaSt%WaveStMod + Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod + Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff + Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff + Init%InData_HD%WvLowCOffD = Init%OutData_SeaSt%WvLowCOffD + Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD + Init%InData_HD%WvLowCOffS = Init%OutData_SeaSt%WvLowCOffS + Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS + Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn + + Init%InData_HD%WaveDirMin = Init%OutData_SeaSt%WaveDirMin + Init%InData_HD%WaveDirMax = Init%OutData_SeaSt%WaveDirMax + Init%InData_HD%WaveDir = Init%OutData_SeaSt%WaveDir + Init%InData_HD%WaveMultiDir = Init%OutData_SeaSt%WaveMultiDir + Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega + Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD + + Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField + + end if + + end if + + ! ........................ + ! initialize HydroDyn + ! ........................ + ALLOCATE( HD%Input( p_FAST%InterpOrder+1 ), HD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input and HD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( p_FAST%CompHydro == Module_HD ) THEN + + Init%InData_HD%Gravity = p_FAST%Gravity + Init%InData_HD%WtrDens = Init%OutData_SeaSt%WtrDens + Init%InData_HD%WtrDpth = Init%OutData_SeaSt%WtrDpth + Init%InData_HD%MSL2SWL = Init%OutData_SeaSt%MSL2SWL + Init%InData_HD%UseInputFile = .TRUE. + Init%InData_HD%InputFile = p_FAST%HydroFile + Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) + Init%InData_HD%TMax = p_FAST%TMax + Init%InData_HD%Linearize = p_FAST%Linearize + + CALL HydroDyn_Init( Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & + HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), Init%OutData_HD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_HD) = .TRUE. + CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + allocate( y_FAST%Lin%Modules(MODULE_HD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_HD%LinNames_y)) call move_alloc(Init%OutData_HD%LinNames_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_HD%LinNames_u)) call move_alloc(Init%OutData_HD%LinNames_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_HD%LinNames_x)) call move_alloc(Init%OutData_HD%LinNames_x, y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_x ) + if (allocated(Init%OutData_HD%DerivOrder_x)) call move_alloc(Init%OutData_HD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_HD%IsLoad_u )) call move_alloc(Init%OutData_HD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(Init%OutData_HD%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + END IF ! CompHydro + + ! ........................ + ! initialize SubDyn or ExtPtfm_MCKF + ! ........................ + ALLOCATE( SD%Input( p_FAST%InterpOrder+1 ), SD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input and SD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( ExtPtfm%Input( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input and ExtPtfm%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( p_FAST%CompSub == Module_SD ) THEN + + IF ( p_FAST%CompHydro == Module_HD ) THEN + Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WtrDpth + ELSE + Init%InData_SD%WtrDpth = 0.0_ReKi + END IF + + Init%InData_SD%Linearize = p_FAST%Linearize + Init%InData_SD%g = p_FAST%Gravity + !Ini%tInData_SD%UseInputFile = .TRUE. + Init%InData_SD%SDInputFile = p_FAST%SubFile + Init%InData_SD%RootName = p_FAST%OutFileRoot + Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to + Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z + + + CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & + SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_SD) = .TRUE. + CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_SD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_SD%LinNames_y)) call move_alloc(Init%OutData_SD%LinNames_y,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_y) + if (allocated(Init%OutData_SD%LinNames_x)) call move_alloc(Init%OutData_SD%LinNames_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_x) + if (allocated(Init%OutData_SD%LinNames_u)) call move_alloc(Init%OutData_SD%LinNames_u,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%Names_u) + if (allocated(Init%OutData_SD%RotFrame_y)) call move_alloc(Init%OutData_SD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_SD%RotFrame_x)) call move_alloc(Init%OutData_SD%RotFrame_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_SD%RotFrame_u)) call move_alloc(Init%OutData_SD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_SD%IsLoad_u )) call move_alloc(Init%OutData_SD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_SD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%NumOutputs = size(Init%OutData_SD%WriteOutputHdr) + if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + + Init%InData_ExtPtfm%InputFile = p_FAST%SubFile + Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + Init%InData_ExtPtfm%Linearize = p_FAST%Linearize + Init%InData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required + + CALL ExtPtfm_Init( Init%InData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & + ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), & + ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. + CALL SetModuleSubstepTime(MODULE_ExtPtfm, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ExtPtfm).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_ExtPtfm%LinNames_y)) call move_alloc(Init%OutData_ExtPtfm%LinNames_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_y) + if (allocated(Init%OutData_ExtPtfm%LinNames_x)) call move_alloc(Init%OutData_ExtPtfm%LinNames_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_x) + if (allocated(Init%OutData_ExtPtfm%LinNames_u)) call move_alloc(Init%OutData_ExtPtfm%LinNames_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_u) + if (allocated(Init%OutData_ExtPtfm%RotFrame_y)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ExtPtfm%RotFrame_x)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ExtPtfm%RotFrame_u)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ExtPtfm%IsLoad_u )) call move_alloc(Init%OutData_ExtPtfm%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_ExtPtfm%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%NumOutputs = size(Init%OutData_ExtPtfm%WriteOutputHdr) + if (allocated(Init%OutData_ExtPtfm%DerivOrder_x)) call move_alloc(Init%OutData_ExtPtfm%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%DerivOrder_x) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + END IF + + ! ------------------------------ + ! initialize CompMooring modules + ! ------------------------------ + ALLOCATE( MAPp%Input( p_FAST%InterpOrder+1 ), MAPp%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input and MAPp%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ALLOCATE( MD%Input( p_FAST%InterpOrder+1 ), MD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ALLOCATE( FEAM%Input( p_FAST%InterpOrder+1 ), FEAM%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input and FEAM%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ALLOCATE( Orca%Input( p_FAST%InterpOrder+1 ), Orca%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input and Orca%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ! ........................ + ! initialize MAP + ! ........................ + IF (p_FAST%CompMooring == Module_MAP) THEN + !bjj: until we modify this, MAP requires HydroDyn to be used. (perhaps we could send air density from AeroDyn or something...) + + CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. + +! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name + Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver + Init%InData_MAP%sea_density = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState + Init%InData_MAP%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState + + ! differences for MAP++ + Init%InData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name + Init%InData_MAP%depth = -Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState + + Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize + + CALL MAP_Init( Init%InData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_MAP) = .TRUE. + CALL SetModuleSubstepTime(Module_MAP, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(Module_MAP)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_MAP%LinInitOut%LinNames_y)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_y ) + if (allocated(Init%OutData_MAP%LinInitOut%LinNames_u)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_u ) + if (allocated(Init%OutData_MAP%LinInitOut%IsLoad_u )) call move_alloc(Init%OutData_MAP%LinInitOut%IsLoad_u ,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(Init%OutData_MAP%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ! ........................ + ! initialize MoorDyn + ! ........................ + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + + ! some new allocations needed with version that's compatible with farm-level use + ALLOCATE( Init%InData_MD%PtfmInit(6,1), Init%InData_MD%TurbineRefPos(3,1), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + Init%InData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_MD%RootName = p_FAST%OutFileRoot + + Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) + Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine + Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 + Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MD%rhoW = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState + Init%InData_MD%WtrDepth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState + Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) + + Init%InData_MD%Linearize = p_FAST%Linearize + + + CALL MD_Init( Init%InData_MD, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, p_FAST%dt_module( MODULE_MD ), Init%OutData_MD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_MD) = .TRUE. + CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_MD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_MD%LinNames_y)) call move_alloc(Init%OutData_MD%LinNames_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_y) + if (allocated(Init%OutData_MD%LinNames_x)) call move_alloc(Init%OutData_MD%LinNames_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_x) + if (allocated(Init%OutData_MD%LinNames_u)) call move_alloc(Init%OutData_MD%LinNames_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_u) + if (allocated(Init%OutData_MD%RotFrame_y)) call move_alloc(Init%OutData_MD%RotFrame_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_MD%RotFrame_x)) call move_alloc(Init%OutData_MD%RotFrame_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_MD%RotFrame_u)) call move_alloc(Init%OutData_MD%RotFrame_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_MD%IsLoad_u )) call move_alloc(Init%OutData_MD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_MD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%NumOutputs = size(Init%OutData_MD%WriteOutputHdr) + if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ! ........................ + ! initialize FEAM + ! ........................ + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + + Init%InData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) + + Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED + Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver + Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState +! Init%InData_FEAM%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState + + CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & + FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. + CALL SetModuleSubstepTime(Module_FEAM, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ! ........................ + ! initialize OrcaFlex Interface + ! ........................ + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + + Init%InData_Orca%InputFile = p_FAST%MooringFile + Init%InData_Orca%RootName = p_FAST%OutFileRoot + Init%InData_Orca%TMax = p_FAST%TMax + + CALL Orca_Init( Init%InData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & + Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), Init%OutData_Orca, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. + CALL SetModuleSubstepTime(MODULE_Orca, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + END IF + + ! ------------------------------ + ! initialize CompIce modules + ! ------------------------------ + ALLOCATE( IceF%Input( p_FAST%InterpOrder+1 ), IceF%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input and IceF%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), + ! but we don't need the space of IceD_MaxLegs if we're not using it. + IF ( p_FAST%CompIce /= Module_IceD ) THEN + IceDim = 1 + ELSE + IceDim = IceD_MaxLegs + END IF + + ! because there may be multiple instances of IceDyn, we'll allocate arrays for that here + ! we could allocate these after + ALLOCATE( IceD%Input( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input and IceD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( IceD%x( IceDim,2), & + IceD%xd( IceDim,2), & + IceD%z( IceDim,2), & + IceD%OtherSt( IceDim,2), & + IceD%p( IceDim ), & + IceD%u( IceDim ), & + IceD%y( IceDim ), & + IceD%m( IceDim ), & + STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceD state, input, and output data.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + + ! ........................ + ! initialize IceFloe + ! ........................ + IF ( p_FAST%CompIce == Module_IceF ) THEN + + Init%InData_IceF%InputFile = p_FAST%IceFile + Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) + Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi + Init%InData_IceF%MSL2SWL = Init%OutData_SeaSt%MSL2SWL + Init%InData_IceF%gravity = p_FAST%Gravity + + CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & + IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_IceF) = .TRUE. + CALL SetModuleSubstepTime(Module_IceF, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ! ........................ + ! initialize IceDyn + ! ........................ + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + + Init%InData_IceD%InputFile = p_FAST%IceFile + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' + Init%InData_IceD%MSL2SWL = Init%OutData_SeaSt%MSL2SWL + Init%InData_IceD%WtrDens = Init%OutData_SeaSt%WtrDens + Init%InData_IceD%gravity = p_FAST%Gravity + Init%InData_IceD%TMax = p_FAST%TMax + Init%InData_IceD%LegNum = 1 + + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & + IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), Init%OutData_IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_IceD) = .TRUE. + CALL SetModuleSubstepTime(Module_IceD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! now initialize IceD for additional legs (if necessary) + dt_IceD = p_FAST%dt_module( MODULE_IceD ) + p_FAST%numIceLegs = Init%OutData_IceD%numLegs + + IF (p_FAST%numIceLegs > IceD_MaxLegs) THEN + CALL SetErrStat(ErrID_Fatal,'IceDyn-FAST coupling is supported for up to '//TRIM(Num2LStr(IceD_MaxLegs))//' legs, but ' & + //TRIM(Num2LStr(p_FAST%numIceLegs))//' legs were specified.',ErrStat,ErrMsg,RoutineName) + END IF + + + DO i=2,p_FAST%numIceLegs ! basically, we just need IceDyn to set up its meshes for inputs/outputs and possibly initial values for states + Init%InData_IceD%LegNum = i + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) + + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & + IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, Init%OutData_IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n IceD modules with n timesteps. + IF (.NOT. EqualRealNos( p_FAST%dt_module( MODULE_IceD ),dt_IceD )) THEN + CALL SetErrStat(ErrID_Fatal,"All instances of IceDyn (one per support-structure leg) must be the same",ErrStat,ErrMsg,RoutineName) + END IF + END DO + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + END IF + + + ! ........................ + ! initialize ServoDyn + ! ........................ + ALLOCATE( SrvD%Input( p_FAST%InterpOrder+1 ), SrvD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input and SrvD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + Init%InData_SrvD%InputFile = p_FAST%ServoFile + Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) + Init%InData_SrvD%NumBl = Init%OutData_ED%NumBl + Init%InData_SrvD%Gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration vector" m/s^2 + Init%InData_SrvD%NacRefPos(1:3) = ED%y%NacelleMotion%Position(1:3,1) + Init%InData_SrvD%NacTransDisp(1:3) = ED%y%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED%TwrBaseRefPos + Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED%TwrBaseTransDisp + Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED%TwrBaseRefOrient ! R8Ki + Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED%TwrBaseOrient ! R8Ki + Init%InData_SrvD%PtfmRefPos(1:3) = ED%y%PlatformPtMesh%Position(1:3,1) + Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y%PlatformPtMesh%TranslationDisp(1:3,1) + Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%TMax = p_FAST%TMax + Init%InData_SrvD%AirDens = AirDens + Init%InData_SrvD%AvgWindSpeed = Init%OutData_IfW%WindFileInfo%MWS + Init%InData_SrvD%Linearize = p_FAST%Linearize + Init%InData_SrvD%TrimCase = p_FAST%TrimCase + Init%InData_SrvD%TrimGain = p_FAST%TrimGain + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed + Init%InData_SrvD%InterpOrder = p_FAST%InterpOrder + + CALL AllocAry( Init%InData_SrvD%BladeRootRefPos, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefPos', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( Init%InData_SrvD%BladeRootTransDisp, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootTransDisp', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( Init%InData_SrvD%BladeRootRefOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefOrient', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( Init%InData_SrvD%BladeRootOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootOrient', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + do k=1,Init%OutData_ED%NumBl + Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) + Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) + enddo + + + IF ( PRESENT(ExternInitData) ) THEN + Init%InData_SrvD%NumSC2CtrlGlob = ExternInitData%NumSC2CtrlGlob + IF ( (Init%InData_SrvD%NumSC2CtrlGlob > 0) ) THEN + CALL AllocAry( Init%InData_SrvD%fromSCGlob, Init%InData_SrvD%NumSC2CtrlGlob, 'Init%InData_SrvD%fromSCGlob', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + do i=1,Init%InData_SrvD%NumSC2CtrlGlob + Init%InData_SrvD%fromSCGlob(i) = ExternInitData%fromSCGlob(i) + end do + END IF + + Init%InData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + IF ( (Init%InData_SrvD%NumSC2Ctrl > 0) ) THEN + CALL AllocAry( Init%InData_SrvD%fromSC, Init%InData_SrvD%NumSC2Ctrl, 'Init%InData_SrvD%fromSC', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + do i=1,Init%InData_SrvD%NumSC2Ctrl + Init%InData_SrvD%fromSC(i) = ExternInitData%fromSC(i) + end do + END IF + + Init%InData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC + + ELSE + Init%InData_SrvD%NumSC2CtrlGlob = 0 + Init%InData_SrvD%NumSC2Ctrl = 0 + Init%InData_SrvD%NumCtrl2SC = 0 + END IF + + ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. + call SetSrvDCableControls() + + + CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them + CALL Cleanup() + RETURN + end if + + Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p_FAST%ModuleInitialized(Module_SrvD) = .TRUE. + + !IF ( Init%OutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! + + CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? + + allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_SrvD%LinNames_y)) call move_alloc(Init%OutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_SrvD%LinNames_u)) call move_alloc(Init%OutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_SrvD%LinNames_x)) call move_alloc(Init%OutData_SrvD%LinNames_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_x ) + if (allocated(Init%OutData_SrvD%RotFrame_y)) call move_alloc(Init%OutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_SrvD%RotFrame_u)) call move_alloc(Init%OutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_SrvD%RotFrame_x)) call move_alloc(Init%OutData_SrvD%RotFrame_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_x ) + if (allocated(Init%OutData_SrvD%IsLoad_u )) call move_alloc(Init%OutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_SrvD%DerivOrder_x)) call move_alloc(Init%OutData_SrvD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%DerivOrder_x) + + if (allocated(Init%OutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(Init%OutData_SrvD%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ! ........................ + ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: + ! (DO NOT COPY THIS CODE!) + ! ........................ + ! bjj: this is a hack to get high-speed shaft braking in FAST v8 + + IF ( Init%OutData_SrvD%UseHSSBrake ) THEN + IF ( p_FAST%CompAero == Module_AD14 ) THEN + IF ( AD14%p%DYNINFL ) THEN + CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) + END IF + END IF + + + IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters + CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) + ENDIF + END IF ! Init%OutData_SrvD%UseHSSBrake + + + END IF + + + ! ........................ + ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) + ! ........................ + + CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! ------------------------------------------------------------------------- + ! Initialize tight coupling solver + ! ------------------------------------------------------------------------- + + CALL Solver_Init(p_FAST%Solver, m_FAST%Solver, m_FAST%Modules, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ! ------------------------------------------------------------------------- + ! Initialize mesh-mapping data + ! ------------------------------------------------------------------------- + + CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + ELSEIF (ErrStat /= ErrID_None) THEN + ! a little work-around in case the mesh mapping info messages get too long + CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) + ErrStat = ErrID_None + ErrMsg = "" + END IF + + ! ------------------------------------------------------------------------- + ! Initialize for linearization: + ! ------------------------------------------------------------------------- + if ( p_FAST%Linearize ) then + ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which + ! is consistent with the current AD implementation, but if AD changes this, then it must be handled here, too! + if (p_FAST%CompAero == MODULE_AD) then + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) + else + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) + endif + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + end if + + + ! ------------------------------------------------------------------------- + ! Initialize data for VTK output + ! ------------------------------------------------------------------------- + if ( p_FAST%WrVTK > VTK_None ) then + call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%InData_SeaSt, Init%OutData_SeaSt, ED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + ! ------------------------------------------------------------------------- + ! Write initialization data to FAST summary file: + ! ------------------------------------------------------------------------- + if (p_FAST%SumPrint) then + CALL FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + + + ! ------------------------------------------------------------------------- + ! other misc variables initialized here: + ! ------------------------------------------------------------------------- + + m_FAST%t_global = t_initial + + ! Initialize external inputs for first step + if ( p_FAST%CompServo == MODULE_SrvD ) then + m_FAST%ExternInput%GenTrq = SrvD%Input(1)%ExternalGenTrq !0.0_ReKi + m_FAST%ExternInput%ElecPwr = SrvD%Input(1)%ExternalElecPwr + m_FAST%ExternInput%YawPosCom = SrvD%Input(1)%ExternalYawPosCom + m_FAST%ExternInput%YawRateCom = SrvD%Input(1)%ExternalYawRateCom + m_FAST%ExternInput%HSSBrFrac = SrvD%Input(1)%ExternalHSSBrFrac + + do i=1,SIZE(SrvD%Input(1)%ExternalBlPitchCom) + m_FAST%ExternInput%BlPitchCom(i) = SrvD%Input(1)%ExternalBlPitchCom(i) + end do + + do i=1,SIZE(SrvD%Input(1)%ExternalBlAirfoilCom) + m_FAST%ExternInput%BlAirfoilCom(i) = SrvD%Input(1)%ExternalBlAirfoilCom(i) + end do + + ! Cable Controls (only 20 channels are passed to simulink, but may be less or more in SrvD) + if (allocated(SrvD%Input(1)%ExternalCableDeltaL)) then + do i=1,min(SIZE(m_FAST%ExternInput%CableDeltaL),SIZE(SrvD%Input(1)%ExternalCableDeltaL)) + m_FAST%ExternInput%CableDeltaL(i) = SrvD%Input(1)%ExternalCableDeltaL(i) + end do + else ! Initialize to zero for consistency + m_FAST%ExternInput%CableDeltaL = 0.0_Reki + endif + if (allocated(SrvD%Input(1)%ExternalCableDeltaLdot)) then + do i=1,min(SIZE(m_FAST%ExternInput%CableDeltaLdot),SIZE(SrvD%Input(1)%ExternalCableDeltaLdot)) + m_FAST%ExternInput%CableDeltaLdot(i) = SrvD%Input(1)%ExternalCableDeltaLdot(i) + end do + else ! Initialize to zero for consistency + m_FAST%ExternInput%CableDeltaLdot = 0.0_Reki + endif + end if + + + + + !............................................................................................................................... + ! Destroy initializion data + !............................................................................................................................... + CALL Cleanup() + +CONTAINS + SUBROUTINE Cleanup() + !............................................................................................................................... + ! Destroy initializion data + !............................................................................................................................... + ! We assume that all initializion data points to parameter data, so we just nullify the pointers instead of deallocate + ! data that they point to: + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + END SUBROUTINE Cleanup + + SUBROUTINE SetSrvDCableControls() + ! There is probably a better method for doint this, but this will work for now. Kind of an ugly bit of hacking. + Init%InData_SrvD%NumCableControl = 0 + if (allocated(Init%OutData_SD%CableCChanRqst)) then + Init%InData_SrvD%NumCableControl = max(Init%InData_SrvD%NumCableControl, size(Init%OutData_SD%CableCChanRqst)) + endif + if (allocated(Init%OutData_MD%CableCChanRqst)) then + Init%InData_SrvD%NumCableControl = max(Init%InData_SrvD%NumCableControl, size(Init%OutData_MD%CableCChanRqst)) + endif + ! Set an array listing which modules requested which channels. + ! They may not all be requested, so check the arrays returned from them during initialization. + if (Init%InData_SrvD%NumCableControl > 0) then + call AllocAry(Init%InData_SrvD%CableControlRequestor, Init%InData_SrvD%NumCableControl, 'CableControlRequestor', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them + call Cleanup() + return + endif + ! Fill a string array that we pass to SrvD containing info about which module is using which of the + ! requested channels. This is not strictly necessary, but will greatly simplify troubleshooting erros + ! with the setup later. + Init%InData_SrvD%CableControlRequestor = '' + do I=1,Init%InData_SrvD%NumCableControl + ! SD -- lots of logic here since we don't know if SD did the requesting of the channels + if (allocated(Init%OutData_SD%CableCChanRqst)) then + if (I <= size(Init%OutData_SD%CableCChanRqst)) then + if (Init%OutData_SD%CableCChanRqst(I)) then + if (len_trim(Init%InData_SrvD%CableControlRequestor(I))>0) Init%InData_SrvD%CableControlRequestor(I) = trim(Init%InData_SrvD%CableControlRequestor(I))//', ' + Init%InData_SrvD%CableControlRequestor(I) = trim(Init%InData_SrvD%CableControlRequestor(I))//trim(y_FAST%Module_Ver( Module_SD )%Name) + endif + endif + endif + ! MD -- lots of logic here since we don't know if MD did the requesting of the channels + if (allocated(Init%OutData_MD%CableCChanRqst)) then + if (I <= size(Init%OutData_MD%CableCChanRqst)) then + if (Init%OutData_MD%CableCChanRqst(I)) then + if (len_trim(Init%InData_SrvD%CableControlRequestor(I))>0) Init%InData_SrvD%CableControlRequestor(I) = trim(Init%InData_SrvD%CableControlRequestor(I))//', ' + Init%InData_SrvD%CableControlRequestor(I) = trim(Init%InData_SrvD%CableControlRequestor(I))//trim(y_FAST%Module_Ver( Module_MD )%Name) + endif + endif + endif + enddo + endif + + ! Now that we actually know which channels are requested, resize the arrays sent into SD and MD. They can both handle + ! larger and sparse arrays. They will simply ignore the channels they aren't looking for., + if (Init%InData_SrvD%NumCableControl > 0) then + ! SD has one array (CableDeltaL) + if (allocated(SD%Input)) then + if (allocated(SD%Input(1)%CableDeltaL)) then + if (size(SD%Input(1)%CableDeltaL)= abortErrLev) then ! make sure allocatable arrays are valid before setting them + call Cleanup() + return + endif + SD%Input(1)%CableDeltaL = 0.0_ReKi + endif + endif + endif + ! Resize the MD arrays as needed -- They may have requested different inputs, but we are passing larger arrays if necessary. + ! MD has two arrays (DeltaL, DeltaLdot) + if (allocated(MD%Input)) then + if (allocated(MD%Input(1)%DeltaL)) then + if (size(MD%Input(1)%DeltaL)= abortErrLev) then ! make sure allocatable arrays are valid before setting them + call Cleanup() + return + endif + MD%Input(1)%DeltaL = 0.0_ReKi + endif + endif + endif + if (allocated(MD%Input)) then + if (allocated(MD%Input(1)%DeltaLdot)) then + if (size(MD%Input(1)%DeltaLdot)= abortErrLev) then ! make sure allocatable arrays are valid before setting them + call Cleanup() + return + endif + MD%Input(1)%DeltaLdot = 0.0_ReKi + endif + endif + endif + endif + END SUBROUTINE SetSrvDCableControls + +END SUBROUTINE FAST_InitializeAll + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is called at the start (or restart) of a FAST program (or FAST.Farm). It initializes the NWTC subroutine library, +!! displays the copyright notice, and displays some version information (including addressing scheme and precision). +SUBROUTINE FAST_ProgStart(ThisProgVer) + TYPE(ProgDesc), INTENT(IN) :: ThisProgVer !< program name/date/version description + + ! ... Initialize NWTC Library + ! sets the pi constants, open console for output, etc... + CALL NWTC_Init( ProgNameIN=ThisProgVer%Name, EchoLibVer=.FALSE. ) + + ! Display the copyright notice and compile info: + CALL DispCopyrightLicense( ThisProgVer%Name ) + CALL DispCompileRuntimeInfo( ThisProgVer%Name ) + +END SUBROUTINE FAST_ProgStart +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine gets the name of the FAST input file from the command line. It also returns a logical indicating if this there +!! was a "DWM" argument after the file name. +SUBROUTINE GetInputFileName(InputFile,UseDWM,ErrStat,ErrMsg) + CHARACTER(*), INTENT(OUT) :: InputFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) + LOGICAL, INTENT(OUT) :: UseDWM !< whether the last argument from the command line is "DWM" + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + + INTEGER(IntKi) :: ErrStat2 ! local error stat + CHARACTER(1024) :: LastArg ! A second command-line argument that will allow DWM module to be used in AeroDyn + + ErrStat = ErrID_None + ErrMsg = '' + + UseDWM = .FALSE. ! by default, we're not going to use the DWM module + InputFile = "" ! initialize to empty string to make sure it's input from the command line + CALL CheckArgs( InputFile, ErrStat2, LastArg ) ! if ErrStat2 /= ErrID_None, we'll ignore and deal with the problem when we try to read the input file + + IF (LEN_TRIM(InputFile) == 0) THEN ! no input file was specified + ErrStat = ErrID_Fatal + ErrMsg = 'The required input file was not specified on the command line.' + RETURN + END IF + + IF (LEN_TRIM(LastArg) > 0) THEN ! see if DWM was specified as the second option + CALL Conv2UC( LastArg ) + IF ( TRIM(LastArg) == "DWM" ) THEN + UseDWM = .TRUE. + END IF + END IF + +END SUBROUTINE GetInputFileName +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine checks for command-line arguments, gets the root name of the input files +!! (including full path name), and creates the names of the output files. +SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) + + IMPLICIT NONE + + ! Passed variables + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< The output data for the FAST (glue-code) simulation + REAL(DbKi), INTENT(IN) :: t_initial !< the beginning time of the simulation + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + CHARACTER(*), INTENT(IN) :: InputFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) + REAL(DbKi), INTENT(IN), OPTIONAL :: TMax !< the length of the simulation (from Simulink or FAST.Farm) + INTEGER(IntKi), INTENT(IN), OPTIONAL :: TurbID !< an ID for naming the tubine output file + LOGICAL, INTENT(IN), OPTIONAL :: OverrideAbortLev !< whether or not we should override the abort error level (e.g., FAST.Farm) + CHARACTER(*), INTENT(IN), OPTIONAL :: RootName !< A CHARACTER string containing the root name of FAST output files, overriding normal naming convention + ! Local variables + + INTEGER :: i ! loop counter + !CHARACTER(1024) :: DirName ! A CHARACTER string containing the path of the current working directory + + + LOGICAL :: OverrideAbortErrLev + CHARACTER(*), PARAMETER :: RoutineName = "FAST_Init" + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + ! Initialize some variables + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(OverrideAbortLev)) THEN + OverrideAbortErrLev = OverrideAbortLev + ELSE + OverrideAbortErrLev = .true. + END IF + + + + !............................................................................................................................... + ! Set the root name of the output files based on the input file name + !............................................................................................................................... + + if (present(RootName)) then + p%OutFileRoot = RootName + else + ! Determine the root name of the primary file (will be used for output files) + CALL GetRoot( InputFile, p%OutFileRoot ) + IF ( Cmpl4SFun ) p%OutFileRoot = TRIM( p%OutFileRoot )//'.SFunc' + IF ( PRESENT(TurbID) ) THEN + IF ( TurbID > 0 ) THEN + p%OutFileRoot = TRIM( p%OutFileRoot )//'.T'//TRIM(Num2LStr(TurbID)) + END IF + END IF + + end if + p%VTK_OutFileRoot = p%OutFileRoot !initialize this here in case of error before it is set later + + + !............................................................................................................................... + ! Initialize the module name/date/version info: + !............................................................................................................................... + + y_FAST%Module_Ver( Module_Glue ) = FAST_Ver + + DO i=2,NumModules + y_FAST%Module_Ver(i)%Date = 'unknown date' + y_FAST%Module_Ver(i)%Ver = 'unknown version' + END DO + y_FAST%Module_Ver( Module_IfW )%Name = 'InflowWind' + y_FAST%Module_Ver( Module_OpFM )%Name = 'OpenFOAM integration' + y_FAST%Module_Ver( Module_ED )%Name = 'ElastoDyn' + y_FAST%Module_Ver( Module_BD )%Name = 'BeamDyn' + y_FAST%Module_Ver( Module_AD14 )%Name = 'AeroDyn14' + y_FAST%Module_Ver( Module_AD )%Name = 'AeroDyn' + y_FAST%Module_Ver( Module_SrvD )%Name = 'ServoDyn' + y_FAST%Module_Ver( Module_SeaSt )%Name = 'SeaState' + y_FAST%Module_Ver( Module_HD )%Name = 'HydroDyn' + y_FAST%Module_Ver( Module_SD )%Name = 'SubDyn' + y_FAST%Module_Ver( Module_ExtPtfm)%Name = 'ExtPtfm_MCKF' + y_FAST%Module_Ver( Module_MAP )%Name = 'MAP' + y_FAST%Module_Ver( Module_FEAM )%Name = 'FEAMooring' + y_FAST%Module_Ver( Module_MD )%Name = 'MoorDyn' + y_FAST%Module_Ver( Module_Orca )%Name = 'OrcaFlexInterface' + y_FAST%Module_Ver( Module_IceF )%Name = 'IceFloe' + y_FAST%Module_Ver( Module_IceD )%Name = 'IceDyn' + + y_FAST%Module_Abrev( Module_Glue ) = 'FAST' + y_FAST%Module_Abrev( Module_IfW ) = 'IfW' + y_FAST%Module_Abrev( Module_OpFM ) = 'OpFM' + y_FAST%Module_Abrev( Module_ED ) = 'ED' + y_FAST%Module_Abrev( Module_BD ) = 'BD' + y_FAST%Module_Abrev( Module_AD14 ) = 'AD' + y_FAST%Module_Abrev( Module_AD ) = 'AD' + y_FAST%Module_Abrev( Module_SrvD ) = 'SrvD' + y_FAST%Module_Abrev( Module_SeaSt ) = 'SEA' + y_FAST%Module_Abrev( Module_HD ) = 'HD' + y_FAST%Module_Abrev( Module_SD ) = 'SD' + y_FAST%Module_Abrev( Module_ExtPtfm) = 'ExtPtfm' + y_FAST%Module_Abrev( Module_MAP ) = 'MAP' + y_FAST%Module_Abrev( Module_FEAM ) = 'FEAM' + y_FAST%Module_Abrev( Module_MD ) = 'MD' + y_FAST%Module_Abrev( Module_Orca ) = 'Orca' + y_FAST%Module_Abrev( Module_IceF ) = 'IceF' + y_FAST%Module_Abrev( Module_IceD ) = 'IceD' + + p%n_substeps = 1 ! number of substeps for between modules and global/FAST time + p%BD_OutputSibling = .false. + + !............................................................................................................................... + ! Read the primary file for the glue code: + !............................................................................................................................... + CALL FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure some linearization variables are consistant + if (.not. p%Linearize) p%CalcSteady = .false. + if (.not. p%CalcSteady) p%TrimCase = TrimCase_none + m_FAST%Lin%FoundSteady = .false. + p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor? + + ! overwrite TMax if necessary) + IF (PRESENT(TMax)) THEN + p%TMax = TMax + !p%TMax = MAX( TMax, p%TMax ) + END IF + + IF ( ErrStat >= AbortErrLev ) RETURN + + + p%KMax = 1 ! after more checking, we may put this in the input file... + !IF (p%CompIce == Module_IceF) p%KMax = 2 + p%SizeJac_Opt1 = 0 ! initialize this vector to zero; after we figure out what size the ED/SD/HD/BD meshes are, we'll fill this + + p%numIceLegs = 0 ! initialize number of support-structure legs in contact with ice (IceDyn will set this later) + + p%nBeams = 0 ! initialize number of BeamDyn instances (will be set later) + + ! determine what kind of turbine we're modeling: + IF ( p%MHK == 1 ) THEN + p%TurbineType = Type_MHK_Fixed + ELSEIF ( p%MHK == 2 ) THEN + p%TurbineType = Type_MHK_Floating + ELSEIF ( p%CompHydro == Module_HD ) THEN + IF ( p%CompSub == Module_SD ) THEN + p%TurbineType = Type_Offshore_Fixed + ELSE + p%TurbineType = Type_Offshore_Floating + END IF + ELSEIF ( p%CompMooring == Module_Orca ) THEN + p%TurbineType = Type_Offshore_Floating + ELSEIF ( p%CompSub == Module_ExtPtfm ) THEN + p%TurbineType = Type_Offshore_Fixed + ELSEIF ( p%MHK == 1 ) THEN + p%TurbineType = Type_MHK_Fixed + ELSEIF ( p%MHK == 2 ) THEN + p%TurbineType = Type_MHK_Floating + ELSE + p%TurbineType = Type_LandBased + END IF + + + p%n_TMax_m1 = CEILING( ( (p%TMax - t_initial) / p%DT ) ) - 1 ! We're going to go from step 0 to n_TMax (thus the -1 here) + + if (p%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error + p%TChanLen = MinChanLen + else + p%TChanLen = max( MinChanLen, int(log10(p%TMax))+7 ) + end if + p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' + + !............................................................................................................................... + ! Do some error checking on the inputs (validation): + !............................................................................................................................... + call ValidateInputData(p, m_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + IF ( ErrStat >= AbortErrLev ) RETURN + + + RETURN +END SUBROUTINE FAST_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates FAST data. +SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< The misc data for the FAST (glue-code) simulation + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + REAL(DbKi) :: TmpTime ! A temporary variable for error checking + + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName='ValidateInputData' + + ErrStat = ErrID_None + ErrMsg = "" + + + IF ( p%TMax < 0.0_DbKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'TMax must not be a negative number.', ErrStat, ErrMsg, RoutineName ) + ELSE IF ( p%TMax < p%TStart ) THEN + CALL SetErrStat( ErrID_Fatal, 'TStart ('//trim(num2lstr(p%TStart))//') should be greater than TMax ('//trim(num2lstr(p%TMax))//') in OpenFAST input file.', ErrStat, ErrMsg, RoutineName ) + END IF + + IF ( p%n_ChkptTime < p%n_TMax_m1 ) THEN + if (.NOT. p%WrBinOutFile) CALL SetErrStat( ErrID_Severe, 'It is highly recommended that time-marching output files be generated in binary format when generating checkpoint files.', ErrStat, ErrMsg, RoutineName ) + if (p%CompMooring==MODULE_Orca) CALL SetErrStat( ErrID_Fatal, 'Restart capability for OrcaFlexInterface is not supported. Set ChkptTime larger than TMax.', ErrStat, ErrMsg, RoutineName ) + ! also check for other features that aren't supported with restart (like ServoDyn's user-defined control routines) + END IF + + IF ( p%DT <= 0.0_DbKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'DT must be greater than 0.', ErrStat, ErrMsg, RoutineName ) + ELSE ! Test DT and TMax to ensure numerical stability -- HINT: see the use of OnePlusEps + TmpTime = p%TMax*EPSILON(p%DT) + IF ( p%DT <= TmpTime ) THEN + CALL SetErrStat( ErrID_Fatal, 'DT must be greater than '//TRIM ( Num2LStr( TmpTime ) )//' seconds.', ErrStat, ErrMsg, RoutineName ) + END IF + END IF + + ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings + CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF ( p%WrTxtOutFile .and. p%FmtWidth < MinChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(p%FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) + + IF ( p%WrTxtOutFile .AND. p%TChanLen > ChanLen ) THEN ! ( p%TMax > 9999.999_DbKi ) + CALL SetErrStat( ErrID_Warn, 'TMax is too large for a '//trim(num2lstr(ChanLen))//'-character time column in text tabular (time-marching) output files.'// & + ' Postprocessors with this limitation may not work.', ErrStat, ErrMsg, RoutineName ) + END IF + + IF ( p%TStart < 0.0_DbKi ) CALL SetErrStat( ErrID_Fatal, 'TStart must not be less than 0 seconds.', ErrStat, ErrMsg, RoutineName ) +! IF ( p%SttsTime <= 0.0_DbKi ) CALL SetErrStat( ErrID_Fatal, 'SttsTime must be greater than 0 seconds.', ErrStat, ErrMsg, RoutineName ) + IF ( p%n_SttsTime < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'SttsTime must be greater than 0 seconds.', ErrStat, ErrMsg, RoutineName ) + IF ( p%n_ChkptTime < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'ChkptTime must be greater than 0 seconds.', ErrStat, ErrMsg, RoutineName ) + IF ( p%KMax < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'KMax must be greater than 0.', ErrStat, ErrMsg, RoutineName ) + + IF (p%CompElast == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompElast must be 1 (ElastoDyn) or 2 (BeamDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompAero == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompAero must be 0 (None), 1 (AeroDyn14), or 2 (AeroDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompServo == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompServo must be 0 (None) or 1 (ServoDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSeaSt == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSeaSt must be 0 (None) or 1 (SeaState).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompHydro == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompHydro must be 0 (None) or 1 (HydroDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSub == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSub must be 0 (None), 1 (SubDyn), or 2 (ExtPtfm_MCKF).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompMooring == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompMooring must be 0 (None), 1 (MAP), 2 (FEAMooring), 3 (MoorDyn), or 4 (OrcaFlex).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompIce == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompIce must be 0 (None) or 1 (IceFloe).', ErrStat, ErrMsg, RoutineName ) + + ! NOTE: If future modules consume SeaState data, then their checks should be added to this routine. 12/1/21 GJH + if (p%CompHydro == Module_HD .and. p%CompSeaSt == Module_None) then + CALL SetErrStat( ErrID_Fatal, 'SeaState must be used when HydroDyn is used. Set CompSeaSt = 1 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + end if + + IF (p%CompHydro /= Module_HD) THEN + IF (p%CompMooring == Module_MAP) THEN + CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when MAP is used. Set CompHydro > 0 or CompMooring = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + ELSEIF (p%CompMooring == Module_FEAM) THEN + CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when FEAMooring is used. Set CompHydro > 0 or CompMooring = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + ELSEIF (p%CompMooring == Module_MD) THEN + CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when MoorDyn is used. Set CompHydro > 0 or CompMooring = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + END IF + ELSE + IF (p%CompMooring == Module_Orca) CALL SetErrStat( ErrID_Fatal, 'HydroDyn cannot be used if OrcaFlex is used. Set CompHydro = 0 or CompMooring < 4 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSub == Module_ExtPtfm) CALL SetErrStat( ErrID_Fatal, 'HydroDyn cannot be used if ExtPtfm_MCKF is used. Set CompHydro = 0 or CompSub < 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + END IF + + IF (p%CompMooring == Module_Orca .and. p%CompSub /= Module_None) CALL SetErrStat( ErrID_Fatal, 'SubDyn and ExtPtfm cannot be used if OrcaFlex is used. Set CompSub = 0 or CompMooring < 4 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + + IF (p%CompIce == Module_IceF) THEN + IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceFloe is used. Set CompSub = 1 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompHydro /= Module_HD) CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when IceFloe is used. Set CompHydro > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + ELSEIF (p%CompIce == Module_IceD) THEN + IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceDyn is used. Set CompSub = 1 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompHydro /= Module_HD) CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when IceDyn is used. Set CompHydro > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + END IF + + IF (p%CompElast == Module_BD .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if (p%CompInflow == MODULE_OpFM .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when OpenFOAM is used. Change CompAero or CompInflow in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + IF (p%MHK /= 0 .and. p%MHK /= 1 .and. p%MHK /= 2) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + IF (p%MHK == 1 .and. p%CompAero == Module_AD14 .or. p%MHK == 2 .and. p%CompAero == Module_AD14) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used with an MHK turbine. Change CompAero or MHK in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + IF (p%MHK == 1 .and. p%Linearize .or. p%MHK == 2 .and. p%Linearize) CALL SetErrStat( ErrID_Fatal, 'Linearization has not yet been implemented for an MHK turbine. Change MHK or Linearize in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + IF (p%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) + + IF (p%WtrDpth < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'WtrDpth must not be negative.', ErrStat, ErrMsg, RoutineName ) + +! IF ( p%InterpOrder < 0 .OR. p%InterpOrder > 2 ) THEN + IF ( p%InterpOrder < 1 .OR. p%InterpOrder > 2 ) THEN + CALL SetErrStat( ErrID_Fatal, 'InterpOrder must be 1 or 2.', ErrStat, ErrMsg, RoutineName ) ! 5/13/14 bjj: MAS and JMJ compromise for certain integrators is that InterpOrder cannot be 0 + p%InterpOrder = 1 ! Avoid problems in error handling by setting this to 0 + END IF + + IF ( p%NumCrctn < 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'NumCrctn must be 0 or greater.', ErrStat, ErrMsg, RoutineName ) + END IF + + + if ( p%WrVTK == VTK_Unknown ) then + call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).', ErrStat, ErrMsg, RoutineName) + else + if ( p%VTK_type == VTK_Unknown ) then + call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) + ! note I'm not going to write that 4 (old) is an option + end if + + if (p%WrVTK == VTK_ModeShapes .and. .not. p%Linearize) then + call SetErrStat(ErrID_Fatal, 'WrVTK cannot be 3 (mode shapes) when Linearize is false. (Mode shapes require linearization analysis.)', ErrStat, ErrMsg, RoutineName) + end if + end if + + if (p%Linearize) then + + if (p%CalcSteady) then + if (p%NLinTimes < 1) call SetErrStat(ErrID_Fatal,'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + if (p%TrimCase /= TrimCase_yaw .and. p%TrimCase /= TrimCase_torque .and. p%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,'TrimCase must be either 1, 2, or 3.',ErrStat, ErrMsg, RoutineName) + end if + + if (p%TrimTol <= epsilon(p%TrimTol)) call SetErrStat(ErrID_Fatal,'TrimTol must be larger than '//trim(num2lstr(epsilon(p%TrimTol)))//'.',ErrStat, ErrMsg, RoutineName) + if (p%Twr_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + if (p%Bld_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Bld_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + else + + if (.not. allocated(m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, 'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + else + do i=1,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) + end do + do i=2,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) <= m_FAST%Lin%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) + end do + + if (m_FAST%Lin%LinTimes(p%NLinTimes) > p%TMax) call SetErrStat(ErrID_Info, 'Tmax is less than the last linearization time. Linearization analysis will not be performed after TMax.',ErrStat, ErrMsg, RoutineName) + end if + + end if + + if (p%LinInputs < LIN_NONE .or. p%LinInputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinInputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) + if (p%LinOutputs < LIN_NONE .or. p%LinOutputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinOutputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) + + if (p%LinOutJac) then + if ( p%LinInputs /= LIN_ALL .or. p%LinOutputs /= LIN_ALL) then + call SetErrStat(ErrID_Info,'LinOutJac can be used only when LinInputs=LinOutputs=2.',ErrStat, ErrMsg, RoutineName) + p%LinOutJac = .false. + end if + end if + + ! now, make sure we haven't asked for any modules that we can't yet linearize: + if (p%CompInflow == MODULE_OpFM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the OpenFOAM coupling.',ErrStat, ErrMsg, RoutineName) + if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) + !if (p%CompSub == MODULE_SD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the SubDyn module.',ErrStat, ErrMsg, RoutineName) + if (p%CompSub /= MODULE_None .and. p%CompSub /= MODULE_SD ) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the ExtPtfm_MCKF substructure module.',ErrStat, ErrMsg, RoutineName) + if (p%CompMooring /= MODULE_None .and. p%CompMooring == MODULE_FEAM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring mooring module.',ErrStat, ErrMsg, RoutineName) + if (p%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) + + end if + + + if ( (p%TurbineType == Type_Offshore_Fixed .or. p%TurbineType == Type_Offshore_Floating) .and. .not. EqualRealNos(p%TurbinePos(3), 0.0_SiKi) ) then + call SetErrStat(ErrID_Fatal, 'Height of turbine location, TurbinePos(3), must be 0 for offshore turbines.', ErrStat, ErrMsg, RoutineName) + end if + + !............................................................................................................................... + + ! temporary check on p_FAST%DT_out + + IF ( .NOT. EqualRealNos( p%DT_out, p%DT ) ) THEN + IF ( p%DT_out < p%DT ) THEN + CALL SetErrStat( ErrID_Fatal, 'DT_out must be at least DT ('//TRIM(Num2LStr(p%DT))//' s).', ErrStat, ErrMsg, RoutineName ) + ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * p%n_DT_Out ) ) THEN + CALL SetErrStat( ErrID_Fatal, 'DT_out must be an integer multiple of DT.', ErrStat, ErrMsg, RoutineName ) + END IF + END IF + + + +END SUBROUTINE ValidateInputData +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the output for the glue code, including writing the header for the primary output file. +SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) + + IMPLICIT NONE + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs + TYPE(FAST_InitData), INTENT(IN) :: Init !< Initialization data for all modules + + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message corresponding to ErrStat + + + ! Local variables. + + INTEGER(IntKi) :: I, J ! Generic index for DO loops. + INTEGER(IntKi) :: indxNext ! The index of the next value to be written to an array + INTEGER(IntKi) :: NumOuts ! number of channels to be written to the output file(s) + + + + !...................................................... + ! Set the description lines to be printed in the output file + !...................................................... + y_FAST%FileDescLines(1) = 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//TRIM(GetVersion(FAST_Ver, Cmpl4SFun, Cmpl4LV)) + y_FAST%FileDescLines(2) = 'linked with ' //' '//TRIM(GetNVD(NWTC_Ver )) ! we'll get the rest of the linked modules in the section below + y_FAST%FileDescLines(3) = 'Description from the FAST input file: '//TRIM(p_FAST%FTitle) + + !...................................................... + ! We'll fill out the rest of FileDescLines(2), + ! and save the module version info for later use, too: + !...................................................... + + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) + + IF ( p_FAST%CompElast == Module_BD ) THEN + y_FAST%Module_Ver( Module_BD ) = Init%OutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_BD ))) + END IF + + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + y_FAST%Module_Ver( Module_IfW ) = Init%OutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IfW ))) + ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN + y_FAST%Module_Ver( Module_OpFM ) = Init%OutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_OpFM ))) + END IF + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + y_FAST%Module_Ver( Module_AD14 ) = Init%OutData_AD14%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD14 ) )) + ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + y_FAST%Module_Ver( Module_AD ) = Init%OutData_AD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD ) )) + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + y_FAST%Module_Ver( Module_SrvD ) = Init%OutData_SrvD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SrvD ))) + END IF + + IF ( p_FAST%CompSeaSt == Module_SeaSt ) THEN + y_FAST%Module_Ver( Module_SeaSt ) = Init%OutData_SeaSt%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SeaSt ))) + END IF + + IF ( p_FAST%CompHydro == Module_HD ) THEN + y_FAST%Module_Ver( Module_HD ) = Init%OutData_HD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_HD ))) + END IF + + IF ( p_FAST%CompSub == Module_SD ) THEN + y_FAST%Module_Ver( Module_SD ) = Init%OutData_SD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SD ))) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + y_FAST%Module_Ver( Module_ExtPtfm ) = Init%OutData_ExtPtfm%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ExtPtfm ))) + END IF + + IF ( p_FAST%CompMooring == Module_MAP ) THEN + y_FAST%Module_Ver( Module_MAP ) = Init%OutData_MAP%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MAP ))) + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + y_FAST%Module_Ver( Module_MD ) = Init%OutData_MD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MD ))) + ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + y_FAST%Module_Ver( Module_FEAM ) = Init%OutData_FEAM%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_FEAM ))) + ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + y_FAST%Module_Ver( Module_Orca ) = Init%OutData_Orca%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_Orca))) + END IF + + IF ( p_FAST%CompIce == Module_IceF ) THEN + y_FAST%Module_Ver( Module_IceF ) = Init%OutData_IceF%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceF ))) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + y_FAST%Module_Ver( Module_IceD ) = Init%OutData_IceD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceD ))) + END IF + + !...................................................... + ! Set the number of output columns from each module + !...................................................... + y_FAST%numOuts = 0 ! Inintialize entire array + + IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(Init%OutData_OpFM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) +do i=1,p_FAST%nBeams + IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) +end do +!ad14 doesn't have outputs: + y_FAST%numOuts(Module_AD14) = 0 + + IF ( ALLOCATED( Init%OutData_AD%rotors)) then + IF ( ALLOCATED( Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%rotors(1)%WriteOutputHdr) + ENDIF + IF ( ALLOCATED( Init%OutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(Init%OutData_SrvD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SeaSt%WriteOutputHdr ) ) y_FAST%numOuts(Module_SeaSt) = SIZE(Init%OutData_SeaSt%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(Init%OutData_HD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(Init%OutData_SD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(Init%OutData_ExtPtfm%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(Init%OutData_MAP%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(Init%OutData_FEAM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(Init%OutData_MD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(Init%OutData_Orca%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(Init%OutData_IceF%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(Init%OutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs + + !...................................................... + ! Initialize the output channel names and units + !...................................................... + y_FAST%numOuts(Module_Glue) = 1 ! time + + + NumOuts = SUM( y_FAST%numOuts ) + + CALL AllocAry( y_FAST%ChannelNames,NumOuts, 'ChannelNames', ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) RETURN + CALL AllocAry( y_FAST%ChannelUnits,NumOuts, 'ChannelUnits', ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) RETURN + + ! Glue outputs: + y_FAST%ChannelNames(1) = 'Time' + y_FAST%ChannelUnits(1) = '(s)' + + + indxNext = y_FAST%numOuts(Module_Glue) + 1 + + DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind + y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_OpFM) !OpenFOAM + y_FAST%ChannelNames(indxNext) = Init%OutData_OpFM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_OpFM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_ED) !ElastoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_ED%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ED%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + IF ( y_FAST%numOuts(Module_BD) > 0_IntKi ) THEN !BeamDyn + do i=1,p_FAST%nBeams + if ( allocated(Init%OutData_BD(i)%WriteOutputHdr) ) then + do j=1,size(Init%OutData_BD(i)%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(Init%OutData_BD(i)%WriteOutputHdr(j)) + y_FAST%ChannelUnits(indxNext) = Init%OutData_BD(i)%WriteOutputUnt(j) + indxNext = indxNext + 1 + end do ! j + end if + end do + END IF + + + ! none for AeroDyn14 + + DO i=1,y_FAST%numOuts(Module_AD) !AeroDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_AD%rotors(1)%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_AD%rotors(1)%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SrvD) !ServoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SrvD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SrvD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SeaSt) !SeaState + y_FAST%ChannelNames(indxNext) = Init%OutData_SeaSt%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SeaSt%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_HD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_HD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SD) !SubDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_ExtPtfm) !ExtPtfm_MCKF + y_FAST%ChannelNames(indxNext) = Init%OutData_ExtPtfm%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ExtPtfm%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MAP) !MAP + y_FAST%ChannelNames(indxNext) = Init%OutData_MAP%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MAP%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MD) !MoorDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_MD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_FEAM) !FEAMooring + y_FAST%ChannelNames(indxNext) = Init%OutData_FEAM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_FEAM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_Orca) !OrcaFlex + y_FAST%ChannelNames(indxNext) = Init%OutData_Orca%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_Orca%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_IceF) !IceFloe + y_FAST%ChannelNames(indxNext) = Init%OutData_IceF%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceF%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + IF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn + DO I=1,p_FAST%numIceLegs + DO J=1,SIZE(Init%OutData_IceD%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) =TRIM(Init%OutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceD%WriteOutputUnt(J) + indxNext = indxNext + 1 + END DO ! J + END DO ! I + END IF + + + !...................................................... + ! Open the text output file and print the headers + !...................................................... + + IF (p_FAST%WrTxtOutFile) THEN + + y_FAST%ActualChanLen = max( MinChanLen, p_FAST%FmtWidth ) + DO I=1,NumOuts + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelNames(I)) ) + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + + CALL GetNewUnit( y_FAST%UnOu, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + CALL OpenFOutFile ( y_FAST%UnOu, TRIM(p_FAST%OutFileRoot)//'.out', ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! Add some file information: + + WRITE (y_FAST%UnOu,'(/,A)') TRIM( y_FAST%FileDescLines(1) ) + WRITE (y_FAST%UnOu,'(1X,A)') TRIM( y_FAST%FileDescLines(2) ) + WRITE (y_FAST%UnOu,'()' ) !print a blank line + WRITE (y_FAST%UnOu,'(A)' ) TRIM( y_FAST%FileDescLines(3) ) + WRITE (y_FAST%UnOu,'()' ) !print a blank line + + + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + if (p_FAST%Delim /= " ") then ! trim trailing spaces if not space delimited: + + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelNames(1)) ) ! first one is time, with a special format + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelNames(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1)(1:p_FAST%TChanLen) ) ! first one is time, with a special format + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if + + WRITE (y_FAST%UnOu,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + + if (p_FAST%Delim /= " ") then + + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelUnits(1)) ) + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1)(1:p_FAST%TChanLen) ) + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if + + WRITE (y_FAST%UnOu,'()') + + END IF + + !...................................................... + ! Allocate data for binary output file + !...................................................... + IF (p_FAST%WrBinOutFile) THEN + + ! calculate the size of the array of outputs we need to store + y_FAST%NOutSteps = CEILING ( (p_FAST%TMax - p_FAST%TStart) / p_FAST%DT_OUT ) + 1 + + CALL AllocAry( y_FAST%AllOutData, NumOuts-1, y_FAST%NOutSteps, 'AllOutData', ErrStat, ErrMsg ) ! this does not include the time channel + IF ( ErrStat >= AbortErrLev ) RETURN + y_FAST%AllOutData = 0.0_ReKi + + IF ( p_FAST%WrBinMod == FileFmtID_WithTime ) THEN ! we store the entire time array + CALL AllocAry( y_FAST%TimeData, y_FAST%NOutSteps, 'TimeData', ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + ELSE + CALL AllocAry( y_FAST%TimeData, 2_IntKi, 'TimeData', ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + y_FAST%TimeData(1) = 0.0_DbKi ! This is the first output time, which we will set later + y_FAST%TimeData(2) = p_FAST%DT_out ! This is the (constant) time between subsequent writes to the output file + END IF + + y_FAST%n_Out = 0 !number of steps actually written to the file + + END IF + + y_FAST%VTK_count = 0 ! first VTK file has 0 as output + +RETURN +END SUBROUTINE FAST_InitOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine reads in the primary FAST input file, does some validation, and places the values it reads in the +!! parameter structure (p). It prints to an echo file if requested. +SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat, ErrMsg ) + + IMPLICIT NONE + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data + LOGICAL, INTENT(IN) :: OverrideAbortErrLev !< Determines if we should override AbortErrLev + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + + ! Local variables: + REAL(DbKi) :: TmpRate ! temporary variable to read VTK_fps before converting to #steps based on DT + REAL(DbKi) :: TmpTime ! temporary variable to read SttsTime and ChkptTime before converting to #steps based on DT + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. + + INTEGER(IntKi) :: IOS ! Temporary Error status + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + INTEGER(IntKi) :: OutFileFmt ! An integer that indicates what kind of tabular output should be generated (1=text, 2=binary, 3=both) + LOGICAL :: Echo ! Determines if an echo file should be written + LOGICAL :: TabDelim ! Determines if text output should be delimited by tabs (true) or space (false) + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(1024) :: PriPath ! Path name of the primary file + + CHARACTER(10) :: AbortLevel ! String that indicates which error level should be used to abort the program: WARNING, SEVERE, or FATAL + CHARACTER(30) :: Line ! string for default entry in input file + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ReadPrimaryFile' + + + ! Initialize some variables: + UnEc = -1 + Echo = .FALSE. ! Don't echo until we've read the "Echo" flag + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + + ! Get an available unit number for the file. + + CALL GetNewUnit( UnIn, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Open the Primary input file. + + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! Read the lines up/including to the "Echo" simulation control variable + ! If echo is FALSE, don't write these lines to the echo file. + ! If Echo is TRUE, rewind and write on the second try. + + I = 1 !set the number of times we've read the file + DO + !-------------------------- HEADER --------------------------------------------- + + CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadStr( UnIn, InputFile, p%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + !---------------------- SIMULATION CONTROL -------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! Echo - Echo input data to .ech (flag): + CALL ReadVar( UnIn, InputFile, Echo, "Echo", "Echo input data to .ech (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop + + ! Otherwise, open the echo file, then rewind the input file and echo everything we've read + + I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) + + CALL OpenEcho ( UnEc, TRIM(p%OutFileRoot)//'.ech', ErrStat2, ErrMsg2, FAST_Ver ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(FAST_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' + + REWIND( UnIn, IOSTAT=ErrStat2 ) + IF (ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".',ErrStat,ErrMsg,RoutineName) + call cleanup() + RETURN + END IF + + END DO + + CALL WrScr( TRIM(FAST_Ver%Name)//' input file heading:' ) + CALL WrScr( ' '//TRIM( p%FTitle ) ) + CALL WrScr('') + + + ! AbortLevel - Error level when simulation should abort: + CALL ReadVar( UnIn, InputFile, AbortLevel, "AbortLevel", "Error level when simulation should abort (string)", & + ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + IF (OverrideAbortErrLev) THEN + ! Let's set the abort level here.... knowing that everything before this aborted only on FATAL errors! + CALL Conv2UC( AbortLevel ) !convert to upper case + SELECT CASE( TRIM(AbortLevel) ) + CASE ( "WARNING" ) + AbortErrLev = ErrID_Warn + CASE ( "SEVERE" ) + AbortErrLev = ErrID_Severe + CASE ( "FATAL" ) + AbortErrLev = ErrID_Fatal + CASE DEFAULT + CALL SetErrStat( ErrID_Fatal, 'Invalid AbortLevel specified in FAST input file. '// & + 'Valid entries are "WARNING", "SEVERE", or "FATAL".',ErrStat,ErrMsg,RoutineName) + call cleanup() + RETURN + END SELECT + END IF + + + ! TMax - Total run time (s): + CALL ReadVar( UnIn, InputFile, p%TMax, "TMax", "Total run time (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! DT - Recommended module time step (s): + CALL ReadVar( UnIn, InputFile, p%DT, "DT", "Recommended module time step (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if ( EqualRealNos(p%DT, 0.0_DbKi) ) then + ! add a fatal error here because we're going to divide by DT later in this routine: + CALL SetErrStat( ErrID_Fatal, 'DT cannot be zero.', ErrStat, ErrMsg, RoutineName) + call cleanup() + return + end if + p%Solver%DT = p%DT + + + ! InterpOrder - Interpolation order for inputs and outputs {0=nearest neighbor ,1=linear, 2=quadratic} + CALL ReadVar( UnIn, InputFile, p%InterpOrder, "InterpOrder", "Interpolation order "//& + "for inputs and outputs {0=nearest neighbor ,1=linear, 2=quadratic} (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! NumCrctn - Number of predictor-corrector iterations {1=explicit calculation, i.e., no corrections} + CALL ReadVar( UnIn, InputFile, p%NumCrctn, "NumCrctn", "Number of corrections"//& + "{0=explicit calculation, i.e., no corrections} (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + p%Solver%NumCrctn = p%NumCrctn + + ! RhoInf - Numerical damping parameter for tight coupling generalized-alpha integrator (-) [0.0 to 1.0] + CALL ReadVar( UnIn, InputFile, p%Solver%RhoInf, "RhoInf", "Numerical damping parameter "//& + "for tight coupling generalized-alpha integrator (-) [0.0 to 1.0]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! MaxConvIter - Maximum number of convergence interations for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%Solver%MaxConvIter, "MaxConvIter", "Maximum number of convergence interations "//& + "for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! ConvTol - Convergence iteration error tolerance for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%Solver%ConvTol, "ConvTol", "Convergence iteration error tolerance for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! NIter_UJac - Update Jacobians every N convergence iterations for tight coupling generalized alpha integrator (-) + CALL ReadVar( UnIn, InputFile, p%Solver%NIter_UJac, "NIter_UJac", "Update Jacobians every N convergence iterations for tight coupling generalized alpha integrator (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! DT_UJac - Time between calls to get Jacobians (s) + CALL ReadVar( UnIn, InputFile, p%DT_UJac, "DT_UJac", "Time between calls to get Jacobians (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + if (p%DT_UJac/p%DT+1 < huge(1_IntKi)) then + p%Solver%NStep_UJac = ceiling(p%DT_UJac/p%DT, IntKi) + else + p%Solver%NStep_UJac = huge(1_IntKi) + end if + + ! UJacSclFact - Scaling factor used in Jacobians (-) + CALL ReadVar( UnIn, InputFile, p%UJacSclFact, "UJacSclFact", "Scaling factor used in Jacobians (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + p%Solver%Scale_UJac = p%UJacSclFact + + !---------------------- FEATURE SWITCHES AND FLAGS -------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Feature Switches and Flags', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! CompElast - Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades}: + CALL ReadVar( UnIn, InputFile, p%CompElast, "CompElast", "Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompElast == 1 ) THEN + p%CompElast = Module_ED + ELSEIF ( p%CompElast == 2 ) THEN + p%CompElast = Module_BD + ELSE + p%CompElast = Module_Unknown + END IF + + ! CompInflow - inflow wind velocities (switch) {0=still air; 1=InflowWind}: + CALL ReadVar( UnIn, InputFile, p%CompInflow, "CompInflow", "inflow wind velocities (switch) {0=still air; 1=InflowWind}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompInflow == 0 ) THEN + p%CompInflow = Module_NONE + ELSEIF ( p%CompInflow == 1 ) THEN + p%CompInflow = Module_IfW + ELSEIF ( p%CompInflow == 2 ) THEN + p%CompInflow = Module_OpFM + ELSE + p%CompInflow = Module_Unknown + END IF + + ! CompAero - Compute aerodynamic loads (switch) {0=None; 1=AeroDyn}: + CALL ReadVar( UnIn, InputFile, p%CompAero, "CompAero", "Compute aerodynamic loads (switch) {0=None; 1=AeroDyn}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompAero == 0 ) THEN + p%CompAero = Module_NONE + ELSEIF ( p%CompAero == 1 ) THEN + p%CompAero = Module_AD14 + ELSEIF ( p%CompAero == 2 ) THEN + p%CompAero = Module_AD + ELSE + p%CompAero = Module_Unknown + END IF + + ! CompServo - Compute control and electrical-drive dynamics (switch) {0=None; 1=ServoDyn}: + CALL ReadVar( UnIn, InputFile, p%CompServo, "CompServo", "Compute control and electrical-drive dynamics (switch) {0=None; 1=ServoDyn}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompServo == 0 ) THEN + p%CompServo = Module_NONE + ELSEIF ( p%CompServo == 1 ) THEN + p%CompServo = Module_SrvD + ELSE + p%CompServo = Module_Unknown + END IF + + + ! CompSeaSt - Compute sea state information (switch) {0=None; 1=SeaState}: + CALL ReadVar( UnIn, InputFile, p%CompSeaSt, "CompSeaSt", "Compute sea state information (switch) {0=None; 1=SeaState}}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompSeaSt == 0 ) THEN + p%CompSeaSt = Module_NONE + ELSEIF ( p%CompSeaSt == 1 ) THEN + p%CompSeaSt = Module_SeaSt + ELSE + p%CompSeaSt = Module_Unknown + END IF + + ! CompHydro - Compute hydrodynamic loads (switch) {0=None; 1=HydroDyn}: + CALL ReadVar( UnIn, InputFile, p%CompHydro, "CompHydro", "Compute hydrodynamic loads (switch) {0=None; 1=HydroDyn}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompHydro == 0 ) THEN + p%CompHydro = Module_NONE + ELSEIF ( p%CompHydro == 1 ) THEN + p%CompHydro = Module_HD + ELSE + p%CompHydro = Module_Unknown + END IF + + ! CompSub - Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=ExtPtfm_MCKF}: + CALL ReadVar( UnIn, InputFile, p%CompSub, "CompSub", "Compute sub-structural dynamics (switch) {0=None; 1=SubDyn}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompSub == 0 ) THEN + p%CompSub = Module_NONE + ELSEIF ( p%CompSub == 1 ) THEN + p%CompSub = Module_SD + ELSEIF ( p%CompSub == 2 ) THEN + p%CompSub = Module_ExtPtfm + ELSE + p%CompSub = Module_Unknown + END IF + + ! CompMooring - Compute mooring line dynamics (flag): + CALL ReadVar( UnIn, InputFile, p%CompMooring, "CompMooring", "Compute mooring system (switch) {0=None; 1=MAP; 2=FEAMooring; 3=MoorDyn; 4=OrcaFlex}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompMooring == 0 ) THEN + p%CompMooring = Module_NONE + ELSEIF ( p%CompMooring == 1 ) THEN + p%CompMooring = Module_MAP + ELSEIF ( p%CompMooring == 2 ) THEN + p%CompMooring = Module_FEAM + ELSEIF ( p%CompMooring == 3 ) THEN + p%CompMooring = Module_MD + ELSEIF ( p%CompMooring == 4 ) THEN + p%CompMooring = Module_Orca + ELSE + p%CompMooring = Module_Unknown + END IF + + ! CompIce - Compute ice loads (switch) {0=None; 1=IceFloe}: + CALL ReadVar( UnIn, InputFile, p%CompIce, "CompIce", "Compute ice loads (switch) {0=None; 1=IceFloe}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompIce == 0 ) THEN + p%CompIce = Module_NONE + ELSEIF ( p%CompIce == 1 ) THEN + p%CompIce = Module_IceF + ELSEIF ( p%CompIce == 2 ) THEN + p%CompIce = Module_IceD + ELSE + p%CompIce = Module_Unknown + END IF + + ! MHK - MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}: + CALL ReadVar( UnIn, InputFile, p%MHK, "MHK", "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + !---------------------- ENVIRONMENTAL CONDITIONS -------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Environmental Conditions', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! Gravity - Gravitational acceleration (m/s^2): + CALL ReadVar( UnIn, InputFile, p%Gravity, "Gravity", "Gravitational acceleration (m/s^2)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! AirDens - Air density (kg/m^3): + CALL ReadVar( UnIn, InputFile, p%AirDens, "AirDens", "Air density (kg/m^3)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! WtrDens - Water density (kg/m^3): + CALL ReadVar( UnIn, InputFile, p%WtrDens, "WtrDens", "Water density (kg/m^3)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! KinVisc - Kinematic viscosity of working fluid (m^2/s): + CALL ReadVar( UnIn, InputFile, p%KinVisc, "KinVisc", "Kinematic viscosity of working fluid (m^2/s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! SpdSound - Speed of sound in working fluid (m/s): + CALL ReadVar( UnIn, InputFile, p%SpdSound, "SpdSound", "Speed of sound in working fluid (m/s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! Patm - Atmospheric pressure (Pa): + CALL ReadVar( UnIn, InputFile, p%Patm, "Patm", "Atmospheric pressure (Pa)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! Pvap - Vapour pressure of working fluid (Pa): + CALL ReadVar( UnIn, InputFile, p%Pvap, "Pvap", "Vapour pressure of working fluid (Pa)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! WtrDpth - Water depth (m): + CALL ReadVar( UnIn, InputFile, p%WtrDpth, "WtrDpth", "Water depth (m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! MSL2SWL - Offset between still-water level and mean sea level (m): + CALL ReadVar( UnIn, InputFile, p%MSL2SWL, "MSL2SWL", "Offset between still-water level and mean sea level (m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + !---------------------- INPUT FILES --------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Input Files', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! EDFile - Name of file containing ElastoDyn input parameters (-): + CALL ReadVar( UnIn, InputFile, p%EDFile, "EDFile", "Name of file containing ElastoDyn input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%EDFile ) ) p%EDFile = TRIM(PriPath)//TRIM(p%EDFile) + +DO i=1,MaxNBlades + ! BDBldFile - Name of file containing BeamDyn blade input parameters (-): + CALL ReadVar( UnIn, InputFile, p%BDBldFile(i), "BDBldFile("//TRIM(num2LStr(i))//")", "Name of file containing BeamDyn blade "//trim(num2lstr(i))//"input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%BDBldFile(i) ) ) p%BDBldFile(i) = TRIM(PriPath)//TRIM(p%BDBldFile(i)) +END DO + + ! InflowFile - Name of file containing inflow wind input parameters (-): + CALL ReadVar( UnIn, InputFile, p%InflowFile, "InflowFile", "Name of file containing inflow wind input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%InflowFile ) ) p%InflowFile = TRIM(PriPath)//TRIM(p%InflowFile) + + ! AeroFile - Name of file containing aerodynamic input parameters (-): + CALL ReadVar( UnIn, InputFile, p%AeroFile, "AeroFile", "Name of file containing aerodynamic input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%AeroFile ) ) p%AeroFile = TRIM(PriPath)//TRIM(p%AeroFile) + + ! ServoFile - Name of file containing control and electrical-drive input parameters (-): + CALL ReadVar( UnIn, InputFile, p%ServoFile, "ServoFile", "Name of file containing control and electrical-drive input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%ServoFile ) ) p%ServoFile = TRIM(PriPath)//TRIM(p%ServoFile) + + ! SeaStFile - Name of file containing sea state input parameters (-): + CALL ReadVar( UnIn, InputFile, p%SeaStFile, "SeaStFile", "Name of file containing sea state input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%SeaStFile ) ) p%SeaStFile = TRIM(PriPath)//TRIM(p%SeaStFile) + + ! HydroFile - Name of file containing hydrodynamic input parameters (-): + CALL ReadVar( UnIn, InputFile, p%HydroFile, "HydroFile", "Name of file containing hydrodynamic input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%HydroFile ) ) p%HydroFile = TRIM(PriPath)//TRIM(p%HydroFile) + + ! SubFile - Name of file containing sub-structural input parameters (-): + CALL ReadVar( UnIn, InputFile, p%SubFile, "SubFile", "Name of file containing sub-structural input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%SubFile ) ) p%SubFile = TRIM(PriPath)//TRIM(p%SubFile) + + ! MooringFile - Name of file containing mooring system input parameters (-): + CALL ReadVar( UnIn, InputFile, p%MooringFile, "MooringFile", "Name of file containing mooring system input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%MooringFile ) ) p%MooringFile = TRIM(PriPath)//TRIM(p%MooringFile) + + ! IceFile - Name of file containing ice input parameters (-): + CALL ReadVar( UnIn, InputFile, p%IceFile, "IceFile", "Name of file containing ice input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%IceFile ) ) p%IceFile = TRIM(PriPath)//TRIM(p%IceFile) + + + !---------------------- OUTPUT -------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! SumPrint - Print summary data to .sum (flag): + CALL ReadVar( UnIn, InputFile, p%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! SttsTime - Amount of time between screen status messages (s): + CALL ReadVar( UnIn, InputFile, TmpTime, "SttsTime", "Amount of time between screen status messages (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + IF (TmpTime > p%TMax) THEN + p%n_SttsTime = HUGE(p%n_SttsTime) + ELSE + p%n_SttsTime = NINT( TmpTime / p%DT ) + END IF + + ! ChkptTime - Amount of time between creating checkpoint files for potential restart (s): + CALL ReadVar( UnIn, InputFile, TmpTime, "ChkptTime", "Amount of time between creating checkpoint files for potential restart (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + IF (TmpTime > p%TMax) THEN + p%n_ChkptTime = HUGE(p%n_ChkptTime) + ELSE + p%n_ChkptTime = NINT( TmpTime / p%DT ) + END IF + + ! DT_Out - Time step for tabular output (s): + CALL ReadVar( UnIn, InputFile, Line, "DT_Out", "Time step for tabular output (s)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InputFile, p%DT_Out, "DT_Out", "Time step for tabular output (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL Conv2UC( Line ) + IF ( INDEX(Line, "DEFAULT" ) == 1 ) THEN + p%DT_Out = p%DT + ELSE + ! If it's not "default", read this variable; otherwise use the value in p%DT + READ( Line, *, IOSTAT=IOS) p%DT_Out + CALL CheckIOS ( IOS, InputFile, 'DT_Out', NumType, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + END IF + + p%n_DT_Out = NINT( p%DT_Out / p%DT ) + + + ! TStart - Time to begin tabular output (s): + CALL ReadVar( UnIn, InputFile, p%TStart, "TStart", "Time to begin tabular output (s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + !> OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 4: HDF5 [.h5], add for combinations} + !! + !! Combinations of output files are possible by adding the values corresponding to each file. The possible combination of options are therefore + !! + !! | `OutFileFmt` | Description | + !! |:------------:|:---------------------------------------------------------------------| + !! | 1 | Text file only `.out` | + !! | 2 | Binary file only `.outb` | + !! | 3 | Text and binary files | + !! | 4 | uncompressed binary file `.outbu` | + !! | 5 | Text and uncompressed binary files | + !! | 6 => 4 | Binary (not written) and uncompressed binary files; same as 4 | + !! | 7 => 5 | Text, Binary (not written), and uncompressed binary files; same as 5 | + !! + + ! OutFileFmt - Format for tabular (time-marching) output file(s) (1: text file [.out], 2: binary file [.outb], 3: both) (-): + CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) {0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary, 4: uncompressed binary .outb]; add for combinations) (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if (OutFileFmt == 0) OutFileFmt = 5 + + ! convert integer to binary representation of which file formats to generate: + p%WrTxtOutFile = mod(OutFileFmt,2) == 1 + + OutFileFmt = OutFileFmt / 2 ! integer division + p%WrBinOutFile = mod(OutFileFmt,2) == 1 + + OutFileFmt = OutFileFmt / 2 ! integer division + if (mod(OutFileFmt,2) == 1) then + ! This is a feature for the regression testing system. It writes binary output stored as uncompressed double floating point data instead of compressed int16 data. + ! If the compressed binary version was requested, that will not be generated + if (p%WrBinOutFile) then + call SetErrStat(ErrID_Warn,'Binary compressed file will not be generated because the uncompressed version was also requested.', ErrStat, ErrMsg, RoutineName) + else + p%WrBinOutFile = .true. + end if + p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) + else + p%WrBinMod = FileFmtID_ChanLen_In ! A format specifier for the binary output file format (4=don't include time channel; do include channel width; do pack data) + end if + + OutFileFmt = OutFileFmt / 2 ! integer division + + if (OutFileFmt /= 0) then + call SetErrStat( ErrID_Fatal, "OutFileFmt must be 0, 1, 2, 3, 4, or 5.",ErrStat,ErrMsg,RoutineName) + call cleanup() + return + end if + + ! TabDelim - Use tab delimiters in text tabular output file? (flag): + CALL ReadVar( UnIn, InputFile, TabDelim, "TabDelim", "Use tab delimiters in text tabular output file? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + IF ( TabDelim ) THEN + p%Delim = TAB + ELSE + p%Delim = ' ' + END IF + + ! OutFmt - Format used for text tabular output (except time). Resulting field should be 10 characters. (-): + CALL ReadVar( UnIn, InputFile, p%OutFmt, "OutFmt", "Format used for text tabular output (except time). Resulting field should be 10 characters. (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + !---------------------- LINEARIZATION ----------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Linearization', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! Linearize - Linearization analysis (flag) + CALL ReadVar( UnIn, InputFile, p%Linearize, "Linearize", "Linearization analysis (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) + CALL ReadVar( UnIn, InputFile, p%CalcSteady, "CalcSteady", "Calculate a steady-state periodic operating point before linearization? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimCase, "TrimCase", "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimTol, "TrimTol", "Tolerance for the rotational speed convergence (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) + CALL ReadVar( UnIn, InputFile, p%TrimGain, "TrimGain", "Proportional gain for the rotational speed error (>0) (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Twr_Kdmp, "Twr_Kdmp", "Damping factor for the tower (N/(m/s))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Bld_Kdmp, "Bld_Kdmp", "Damping factor for the blades (N/(m/s))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! NLinTimes - Number of times to linearize (or number of equally spaced azimuth steps in periodic linearized model) (-) [>=1] + CALL ReadVar( UnIn, InputFile, p%NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if (.not. p%Linearize) then + p%CalcSteady = .false. + p%NLinTimes = 0 + end if + + ! LinTimes - Times to linearize (s) [1 to NLinTimes] + if (.not. p%CalcSteady .and. p%NLinTimes >= 1 ) then + call AllocAry( m_FAST%Lin%LinTimes, p%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadAry( UnIn, InputFile, m_FAST%Lin%LinTimes, p%NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) + else + CALL ReadCom( UnIn, InputFile, 'Times to linearize (s) [1 to NLinTimes] ', ErrStat2, ErrMsg2, UnEc ) + end if + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} + CALL ReadVar( UnIn, InputFile, p%LinInputs, "LinInputs", "Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! LinOutputs - Include outputs in linearization (switch) (0=none; 1=from OutList(s); 2=all module outputs (debug)) + CALL ReadVar( UnIn, InputFile, p%LinOutputs, "LinOutputs", "Include outputs in linearization (switch) (0=none; 1=from OutList(s); 2=all module outputs (debug))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! LinOutJac - Include full Jacabians in linearization output (for debug) (flag) + CALL ReadVar( UnIn, InputFile, p%LinOutJac, "LinOutJac", "Include full Jacabians in linearization output (for debug) (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! LinOutMod - Write module-level linearization output files in addition to output for full system? (flag) + CALL ReadVar( UnIn, InputFile, p%LinOutMod, "LinOutMod", "Write module-level linearization output files in addition to output for full system? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + !---------------------- VISUALIZATION ----------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes}: + CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation; 3=mode shapes)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + IF ( p%WrVTK < 0 .OR. p%WrVTK > 3 ) THEN + p%WrVTK = VTK_Unknown + END IF + + ! VTK_Type - Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)}: + CALL ReadVar( UnIn, InputFile, p%VTK_Type, "VTK_Type", "Type of VTK visualization data: (1=surfaces; 2=basic meshes (lines/points); 3=all meshes)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%VTK_Type == 0 ) THEN + p%VTK_Type = VTK_None + ELSEIF ( p%VTK_Type == 1 ) THEN + p%VTK_Type = VTK_Surf + ELSEIF ( p%VTK_Type == 2 ) THEN + p%VTK_Type = VTK_Basic + ELSEIF ( p%VTK_Type == 3 ) THEN + p%VTK_Type = VTK_All + ELSEIF ( p%VTK_Type == 4 ) THEN + p%VTK_Type = VTK_Old + ELSE + p%VTK_Type = VTK_Unknown + END IF + + !! equivalent: + !IF ( p%VTK_Type < 0 .OR. p%VTK_Type > 4 ) THEN + ! p%VTK_Type = VTK_Unknown + !END IF + + ! VTK_fields - Write mesh fields to VTK data files? (flag) {true/false}: + CALL ReadVar( UnIn, InputFile, p%VTK_fields, "VTK_fields", "Write mesh fields to VTK data files? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! VTK_fps - Frame rate for VTK output (frames per second) {will use closest integer multiple of DT} + CALL ReadVar( UnIn, InputFile, p%VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! convert frames-per-second to seconds per sample: + if ( EqualRealNos(p%VTK_fps, 0.0_DbKi) ) then + TmpTime = p%TMax + p%DT + else + TmpTime = 1.0_DbKi / p%VTK_fps + end if + + ! now save the number of time steps between VTK file output: + IF (p%WrVTK == VTK_ModeShapes) THEN + p%n_VTKTime = 1 + ELSE IF (TmpTime > p%TMax) THEN + p%n_VTKTime = HUGE(p%n_VTKTime) + ELSE + p%n_VTKTime = NINT( TmpTime / p%DT ) + ! I'll warn if p%n_VTKTime*p%DT is not TmpTime + IF (p%WrVTK == VTK_Animate) THEN + TmpRate = p%n_VTKTime*p%DT + if (.not. EqualRealNos(TmpRate, TmpTime)) then + call SetErrStat(ErrID_Info, '1/VTK_fps is not an integer multiple of DT. FAST will output VTK information at '//& + trim(num2lstr(1.0_DbKi/TmpRate))//' fps, the closest rate possible.',ErrStat,ErrMsg,RoutineName) + end if + END IF + + END IF + + call cleanup() + RETURN + +CONTAINS + !............................................................................................................................... + subroutine cleanup() + CLOSE( UnIn ) + IF ( UnEc > 0 ) CLOSE ( UnEc ) + end subroutine cleanup + !............................................................................................................................... +END SUBROUTINE FAST_ReadPrimaryFile +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up some of the information needed for plotting VTK surfaces. It initializes only the data needed before +!! SeaState initialization. (SeaSt needs some of this data so it can return the wave elevation data we want.) +SUBROUTINE SetVTKParameters_B4SeaSt(p_FAST, InitOutData_ED, InitInData_SeaSt, BD, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code + TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module + TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInData_SeaSt !< The initialization input to SeaState + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + REAL(SiKi) :: BladeLength, Width, WidthBy2 + REAL(SiKi) :: dx, dy + INTEGER(IntKi) :: i, j, n + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters_B4SeaSt' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get radius for ground (blade length + hub radius): + if ( p_FAST%CompElast == Module_BD ) then + BladeLength = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) + else + BladeLength = InitOutData_ED%BladeLength + end if + p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad + p_FAST%VTK_Surface%GroundRad = BladeLength + p_FAST%VTK_Surface%HubRad + + !........................................................................................................ + ! We don't use the rest of this routine for stick-figure output + if (p_FAST%VTK_Type /= VTK_Surf) return + !........................................................................................................ + + ! initialize wave elevation data: + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + + p_FAST%VTK_surface%NWaveElevPts(1) = 25 + p_FAST%VTK_surface%NWaveElevPts(2) = 25 + + call allocAry( InitInData_SeaSt%WaveElevXY, 2, p_FAST%VTK_surface%NWaveElevPts(1)*p_FAST%VTK_surface%NWaveElevPts(2), 'WaveElevXY', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + Width = p_FAST%VTK_Surface%GroundRad * VTK_GroundFactor + dx = Width / (p_FAST%VTK_surface%NWaveElevPts(1) - 1) + dy = Width / (p_FAST%VTK_surface%NWaveElevPts(2) - 1) + + WidthBy2 = Width / 2.0_SiKi + n = 1 + do i=1,p_FAST%VTK_surface%NWaveElevPts(1) + do j=1,p_FAST%VTK_surface%NWaveElevPts(2) + InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! HD takes p_FAST%TurbinePos into account already + InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 !+ p_FAST%TurbinePos(2) + n = n+1 + end do + end do + + end if + + +END SUBROUTINE SetVTKParameters_B4SeaSt +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up the information needed for plotting VTK surfaces. +SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_SeaSt, InitOutData_SeaSt, ED, BD, AD, HD, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code + TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutData_AD !< The initialization output from AeroDyn + TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInData_SeaSt !< The initialization input to SeaState + TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutData_SeaSt !< The initialization output from SeaState + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + REAL(SiKi) :: RefPoint(3), RefLengths(2) + REAL(SiKi) :: x, y + REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength + INTEGER(IntKi) :: topNode, baseNode + INTEGER(IntKi) :: NumBl, k + CHARACTER(1024) :: vtkroot + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' + INTEGER(IntKi) :: rootNode, cylNode, tipNode + + + ErrStat = ErrID_None + ErrMsg = "" + + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and + ! create the VTK directory if it does not exist + + call GetPath ( p_FAST%OutFileRoot, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // 'vtk' + + call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) + + p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + if (p_FAST%WrVTK == VTK_ModeShapes .AND. p_FAST%VTK_modes%VTKLinTim==1) then + if (p_FAST%NLinTimes < 1) p_FAST%NLinTimes = 1 !in case we reached here with an error + p_FAST%VTK_tWidth = CEILING( log10( real( p_FAST%NLinTimes) ) ) + 1 + else + p_FAST%VTK_tWidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 + end if + + ! determine number of blades + NumBl = InitOutData_ED%NumBl + + ! initialize the vtk data + + p_FAST%VTK_Surface%NumSectors = 25 + ! NOTE: we set p_FAST%VTK_Surface%GroundRad and p_FAST%VTK_Surface%HubRad in SetVTKParameters_B4SeaSt + + + ! write the ground or seabed reference polygon: + RefPoint = p_FAST%TurbinePos + if (p_FAST%CompSeaSt == MODULE_SeaSt) then + RefLengths = p_FAST%VTK_Surface%GroundRad*VTK_GroundFactor/2.0_SiKi + + ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines + RefPoint(3) = p_FAST%TurbinePos(3) - p_FAST%WtrDpth + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.SeabedSurface', ErrStat2, ErrMsg2 ) + + RefPoint(3) = p_FAST%TurbinePos(3) - p_FAST%MSL2SWL + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) + else + RefLengths = p_FAST%VTK_Surface%GroundRad !array = scalar + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', ErrStat2, ErrMsg2 ) + end if + + + !........................................................................................................ + ! We don't use the rest of this routine for stick-figure output + if (p_FAST%VTK_Type /= VTK_Surf) return + !........................................................................................................ + + ! we're going to create a box using these dimensions + y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + + + p_FAST%VTK_Surface%NacelleBox(:,1) = (/ -x, y, 0.0_SiKi /) + p_FAST%VTK_Surface%NacelleBox(:,2) = (/ x, y, 0.0_SiKi /) + p_FAST%VTK_Surface%NacelleBox(:,3) = (/ x, -y, 0.0_SiKi /) + p_FAST%VTK_Surface%NacelleBox(:,4) = (/ -x, -y, 0.0_SiKi /) + p_FAST%VTK_Surface%NacelleBox(:,5) = (/ -x, -y, 2*y /) + p_FAST%VTK_Surface%NacelleBox(:,6) = (/ x, -y, 2*y /) + p_FAST%VTK_Surface%NacelleBox(:,7) = (/ x, y, 2*y /) + p_FAST%VTK_Surface%NacelleBox(:,8) = (/ -x, y, 2*y /) + + !....................... + ! tapered tower + !....................... + + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + topNode = ED%y%TowerLn2Mesh%NNodes - 1 + baseNode = ED%y%TowerLn2Mesh%refNode + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower + TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower + TwrDiam_top = 3.87*TwrRatio + TwrDiam_base = 6.0*TwrRatio + + TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength + do k=1,ED%y%TowerLn2Mesh%NNodes + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) + p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength + end do + + + + !....................... + ! blade surfaces + !....................... + allocate(p_FAST%VTK_Surface%BladeShape(NumBl),stat=ErrStat2) + if (errStat2/=0) then + call setErrStat(ErrID_Fatal,'Error allocating VTK_Surface%BladeShape.',ErrStat,ErrMsg,RoutineName) + return + end if + + IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... + + IF (ALLOCATED(InitOutData_AD%rotors(1)%BladeShape)) THEN + do k=1,NumBl + call move_alloc( InitOutData_AD%rotors(1)%BladeShape(k)%AirfoilCoords, p_FAST%VTK_Surface%BladeShape(k)%AirfoilCoords ) + end do + ELSE + ! AD used without airfoil coordinates specified + call WrScr('Using generic blade surfaces for AeroDyn (S809 airfoil, assumed chord, twist, AC). ') + + rootNode = 1 + + DO K=1,NumBl + tipNode = AD%Input(1)%rotors(1)%BladeMotion(K)%NNodes + cylNode = min(3,AD%Input(1)%rotors(1)%BladeMotion(K)%Nnodes) + + call SetVTKDefaultBladeParams(AD%Input(1)%rotors(1)%BladeMotion(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 1, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + END DO + END IF + + ELSE IF ( p_FAST%CompElast == Module_BD ) THEN + call WrScr('Using generic blade surfaces for BeamDyn (rectangular airfoil, constant chord). ') ! TODO make this an option + rootNode = 1 + DO K=1,NumBl + tipNode = BD%y(k)%BldMotion%NNodes + cylNode = min(3,BD%y(k)%BldMotion%NNodes) + + call SetVTKDefaultBladeParams(BD%y(k)%BldMotion, p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + END DO + ELSE + call WrScr('Using generic blade surfaces for ElastoDyn (rectangular airfoil, constant chord). ') ! TODO make this an option + DO K=1,NumBl + rootNode = ED%y%BladeLn2Mesh(K)%NNodes + tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 + cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) + + call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 4, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + END DO + END IF + + + !....................... + ! wave elevation + !....................... + + !bjj: interpolate here instead of each time step? + if ( allocated(InitOutData_SeaSt%WaveElevSeries) ) then + call move_alloc( InitInData_SeaSt%WaveElevXY, p_FAST%VTK_Surface%WaveElevXY ) + call move_alloc( InitOutData_SeaSt%WaveElevSeries, p_FAST%VTK_Surface%WaveElev ) + + ! put the following lines in loops to avoid stack-size issues: + do k=1,size(p_FAST%VTK_Surface%WaveElevXY,2) + p_FAST%VTK_Surface%WaveElevXY(:,k) = p_FAST%VTK_Surface%WaveElevXY(:,k) + p_FAST%TurbinePos(1:2) + end do + + end if + + !....................... + ! morison surfaces + !....................... + + IF ( HD%Input(1)%Morison%Mesh%Committed ) THEN + !TODO: FIX for visualization GJH 4/23/20 + ! call move_alloc(InitOutData_HD%Morison%Morison_Rad, p_FAST%VTK_Surface%MorisonRad) + + END IF + +END SUBROUTINE SetVTKParameters +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine comes up with some default airfoils for blade surfaces for a given blade mesh, M. +SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, iShape, ErrStat, ErrMsg) + + TYPE(MeshType), INTENT(IN ) :: M !< The Mesh the defaults should be calculated for + TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: BladeShape !< BladeShape to set to default values + INTEGER(IntKi), INTENT(IN ) :: rootNode !< Index of root node (innermost node) for this mesh + INTEGER(IntKi), INTENT(IN ) :: tipNode !< Index of tip node (outermost node) for this mesh + INTEGER(IntKi), INTENT(IN ) :: cylNode !< Index of last node to have a cylinder shape + INTEGER(IntKi), INTENT(IN ) :: iShape !< 1: S809, 2: circle, 3: square, 4: rectangle + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + REAL(SiKi) :: bladeLength, chord, pitchAxis + REAL(SiKi) :: bladeLengthFract, bladeLengthFract2, ratio, posLength ! temporary quantities + REAL(SiKi) :: cylinderLength, x, y, angle + INTEGER(IntKi) :: i, j + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKDefaultBladeParams' + integer :: N ! Number of points for airfoil + real, allocatable, dimension(:) :: xc, yc ! Coordinate of airfoil + + ErrStat = ErrID_None + ErrMsg = '' + + select case (iShape) + case (1) + N=66 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + xc=(/ 1.0,0.996203,0.98519,0.967844,0.945073,0.917488,0.885293,0.848455,0.80747,0.763042,0.715952,0.667064,0.617331,0.56783,0.519832,0.474243,0.428461,0.382612,0.33726,0.29297,0.250247,0.209576,0.171409,0.136174,0.104263,0.076035,0.051823,0.03191,0.01659,0.006026,0.000658,0.000204,0.0,0.000213,0.001045,0.001208,0.002398,0.009313,0.02323,0.04232,0.065877,0.093426,0.124111,0.157653,0.193738,0.231914,0.271438,0.311968,0.35337,0.395329,0.438273,0.48192,0.527928,0.576211,0.626092,0.676744,0.727211,0.776432,0.823285,0.86663,0.905365,0.938474,0.965086,0.984478,0.996141,1.0 /) + yc=(/ 0.0,0.000487,0.002373,0.00596,0.011024,0.017033,0.023458,0.03028,0.037766,0.045974,0.054872,0.064353,0.074214,0.084095,0.093268,0.099392,0.10176,0.10184,0.10007,0.096703,0.091908,0.085851,0.078687,0.07058,0.061697,0.052224,0.042352,0.032299,0.02229,0.012615,0.003723,0.001942,-0.00002,-0.001794,-0.003477,-0.003724,-0.005266,-0.011499,-0.020399,-0.030269,-0.040821,-0.051923,-0.063082,-0.07373,-0.083567,-0.092442,-0.099905,-0.105281,-0.108181,-0.108011,-0.104552,-0.097347,-0.086571,-0.073979,-0.060644,-0.047441,-0.0351,-0.024204,-0.015163,-0.008204,-0.003363,-0.000487,0.000743,0.000775,0.00029,0.0 /) + case (2) + ! Circle + N=21 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + do i=1,N + angle = (i-1)*TwoPi/(N-1) + xc(i) = (cos(angle)+1)/2 ! between 0 and 1, 0.5 substracted later + yc(i) = (sin(angle)+1)/2-0.5 ! between -0.5 and 0.5 + enddo + case (3) + ! Square + N=5 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + xc = (/1.0 , 0.0 , 0.0 , 1.0 , 1.0/) ! between 0 and 1, 0.5 substracted later + yc = (/-0.5 , -0.5 , 0.5 , 0.5 , -0.5/) ! between -0.5 and 0.5 + case (4) + ! Rectangle + N=5 + call AllocAry(xc, N, 'xc', Errstat2, ErrMsg2) + call AllocAry(yc, N, 'yc', Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + xc = (/1.0 , 0.0 , 0.0 , 1.0 , 1.0/) ! between 0 and 1, 0.5 substracted later + yc = (/-0.25 , -0.25 , 0.25 , 0.25 , 0.0/) ! between 0.25 and 0.25 + case default + call SetErrStat(ErrID_Fatal, 'Unknown iShape specfied for VTK default shapes',ErrStat,ErrMsg,RoutineName) + return + end select + + ! default airfoil shape coordinates; uses S809 values from http://wind.nrel.gov/airfoils/Shapes/S809_Shape.html: + call AllocAry(BladeShape%AirfoilCoords, 2, N, M%NNodes, 'BladeShape%AirfoilCoords', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + ! Chord length and pitch axis location are given by scaling law + bladeLength = TwoNorm( M%position(:,tipNode) - M%Position(:,rootNode) ) + cylinderLength = TwoNorm( M%Position(:,cylNode) - M%Position(:,rootNode) ) + bladeLengthFract = 0.22*bladeLength + bladeLengthFract2 = bladeLength-bladeLengthFract != 0.78*bladeLength + + + ! Circle, square or rectangle, constant chord + if (iShape>1) then + chord = bladeLength*0.04 ! chord set to 4% of blade length + DO i=1,M%Nnodes + posLength = TwoNorm( M%Position(:,i) - M%Position(:,rootNode) ) + DO j=1,N + ! normalized x,y coordinates for airfoil + x = yc(j) + y = xc(j) - 0.5 + ! x,y coordinates for cylinder + BladeShape%AirfoilCoords(1,j,i) = chord*x + BladeShape%AirfoilCoords(2,j,i) = chord*y + END DO + enddo + return ! We exit this routine + endif + + ! Assumed chord/twist/AC distribution for a blade + DO i=1,M%Nnodes + posLength = TwoNorm( M%Position(:,i) - M%Position(:,rootNode) ) + + IF (posLength .LE. bladeLengthFract) THEN + ratio = posLength/bladeLengthFract + chord = (0.06 + 0.02*ratio)*bladeLength + pitchAxis = 0.25 + 0.125*ratio + ELSE + chord = (0.08 - 0.06*(posLength-bladeLengthFract)/bladeLengthFract2)*bladeLength + pitchAxis = 0.375 + END IF + + IF (posLength .LE. cylinderLength) THEN + ! create a cylinder for this node + + chord = chord/2.0_SiKi + + DO j=1,N + ! normalized x,y coordinates for airfoil + x = yc(j) + y = xc(j) - 0.5 + + angle = ATAN2( y, x) + + ! x,y coordinates for cylinder + BladeShape%AirfoilCoords(1,j,i) = chord*COS(angle) ! x (note that "chord" is really representing chord/2 here) + BladeShape%AirfoilCoords(2,j,i) = chord*SIN(angle) ! y (note that "chord" is really representing chord/2 here) + END DO + + ELSE + ! create an airfoil for this node + + DO j=1,N + ! normalized x,y coordinates for airfoil, assuming an upwind turbine + x = yc(j) + y = xc(j) - pitchAxis + + ! x,y coordinates for airfoil + BladeShape%AirfoilCoords(1,j,i) = chord*x + BladeShape%AirfoilCoords(2,j,i) = chord*y + END DO + + END IF + + END DO ! nodes on mesh + +END SUBROUTINE SetVTKDefaultBladeParams +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes the ground or seabed reference surface information in VTK format. +!! see VTK file information format for XML, here: http://www.vtk.org/wp-content/uploads/2015/04/file-formats.pdf +SUBROUTINE WrVTK_Ground ( RefPoint, HalfLengths, FileRootName, ErrStat, ErrMsg ) + + REAL(SiKi), INTENT(IN) :: RefPoint(3) !< reference point (plane will be created around it) + REAL(SiKi), INTENT(IN) :: HalfLengths(2) !< half of the X-Y lengths of plane surrounding RefPoint + CHARACTER(*), INTENT(IN) :: FileRootName !< Name of the file to write the output in (excluding extension) + + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Indicates whether an error occurred (see NWTC_Library) + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message associated with the ErrStat + + + ! local variables + INTEGER(IntKi) :: Un ! fortran unit number + INTEGER(IntKi) :: ix ! loop counters + CHARACTER(1024) :: FileName + INTEGER(IntKi), parameter :: NumberOfPoints = 4 + INTEGER(IntKi), parameter :: NumberOfLines = 0 + INTEGER(IntKi), parameter :: NumberOfPolys = 1 + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_Ground' + + ErrStat = ErrID_None + ErrMsg = "" + + !................................................................. + ! write the data that potentially changes each time step: + !................................................................. + + ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file + FileName = TRIM(FileRootName)//'.vtp' + + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + +! points (nodes, augmented with NumSegments): + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) - HalfLengths(2), RefPoint(3) + WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'('//trim(num2lstr(NumberOfPoints))//'(i7))') (ix, ix=0,NumberOfPoints-1) + WRITE(Un,'(A)') ' ' + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(i7)') NumberOfPoints + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + call WrVTK_footer( Un ) + +END SUBROUTINE WrVTK_Ground +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up the information needed to initialize AeroDyn, then initializes AeroDyn +SUBROUTINE AD_SetInitInput(InitInData_AD14, InitOutData_ED, y_ED, p_FAST, ErrStat, ErrMsg) + + ! Passed variables: + TYPE(AD14_InitInputType),INTENT(INOUT) :: InitInData_AD14 !< The initialization input to AeroDyn14 + TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< The initialization output from structural dynamics module + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (meshes with position/RefOrientation set) + TYPE(FAST_ParameterType),INTENT(IN) :: p_FAST !< The parameters of the glue code + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables + + !TYPE(AD_InitOptions) :: ADOptions ! Options for AeroDyn + + INTEGER :: K + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Set up the AeroDyn parameters + InitInData_AD14%ADFileName = p_FAST%AeroFile + InitInData_AD14%OutRootName = p_FAST%OutFileRoot + InitInData_AD14%WrSumFile = p_FAST%SumPrint + InitInData_AD14%NumBl = InitOutData_ED%NumBl + InitInData_AD14%UseDWM = p_FAST%UseDWM + + InitInData_AD14%DWM%IfW%InputFileName = p_FAST%InflowFile + + ! Hub position and orientation (relative here, but does not need to be) + + InitInData_AD14%TurbineComponents%Hub%Position(:) = y_ED%HubPtMotion14%Position(:,1) - y_ED%HubPtMotion14%Position(:,1) ! bjj: was 0; mesh was changed by adding p_ED%HubHt to 3rd component + InitInData_AD14%TurbineComponents%Hub%Orientation(:,:) = y_ED%HubPtMotion14%RefOrientation(:,:,1) + InitInData_AD14%TurbineComponents%Hub%TranslationVel = 0.0_ReKi ! bjj: we don't need this field + InitInData_AD14%TurbineComponents%Hub%RotationVel = 0.0_ReKi ! bjj: we don't need this field + + ! Blade root position and orientation (relative here, but does not need to be) + + IF (.NOT. ALLOCATED( InitInData_AD14%TurbineComponents%Blade ) ) THEN + ALLOCATE( InitInData_AD14%TurbineComponents%Blade( InitInData_AD14%NumBl ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TurbineComponents%Blade.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + DO K=1, InitInData_AD14%NumBl + InitInData_AD14%TurbineComponents%Blade(K)%Position = y_ED%BladeRootMotion14%Position(:,K) + InitInData_AD14%TurbineComponents%Blade(K)%Orientation = y_ED%BladeRootMotion14%RefOrientation(:,:,K) + InitInData_AD14%TurbineComponents%Blade(K)%TranslationVel = 0.0_ReKi ! bjj: we don't need this field + InitInData_AD14%TurbineComponents%Blade(K)%RotationVel = 0.0_ReKi ! bjj: we don't need this field + END DO + + + ! Blade length + IF (p_FAST%CompElast == Module_ED) THEN ! note, we can't get here if we're using BeamDyn.... + InitInData_AD14%TurbineComponents%BladeLength = InitOutData_ED%BladeLength + END IF + + + ! Tower mesh ( here only because we currently need line2 meshes to contain the same nodes/elements ) + + InitInData_AD14%NumTwrNodes = y_ED%TowerLn2Mesh%NNodes - 2 + IF (.NOT. ALLOCATED( InitInData_AD14%TwrNodeLocs ) ) THEN + ALLOCATE( InitInData_AD14%TwrNodeLocs( 3, InitInData_AD14%NumTwrNodes ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrNodeLocs.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + IF ( InitInData_AD14%NumTwrNodes > 0 ) THEN + InitInData_AD14%TwrNodeLocs = y_ED%TowerLn2Mesh%Position(:,1:InitInData_AD14%NumTwrNodes) ! ED has extra nodes at beginning and top and bottom of tower + END IF + + ! hub height + InitInData_AD14%HubHt = InitOutData_ED%HubHt + + + RETURN +END SUBROUTINE AD_SetInitInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the number of subcycles (substeps) for modules at initialization, checking to make sure that their requested +!! time step is valid. +SUBROUTINE SetModuleSubstepTime(ModuleID, p_FAST, y_FAST, ErrStat, ErrMsg) + INTEGER(IntKi), INTENT(IN ) :: ModuleID !< ID of the module to check time step and set + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( EqualRealNos( p_FAST%dt_module( ModuleID ), p_FAST%dt ) ) THEN + p_FAST%n_substeps(ModuleID) = 1 + ELSE + IF ( p_FAST%dt_module( ModuleID ) > p_FAST%dt ) THEN + ErrStat = ErrID_Fatal + ErrMsg = "The "//TRIM(y_FAST%Module_Ver(ModuleID)%Name)//" module time step ("//& + TRIM(Num2LStr(p_FAST%dt_module( ModuleID )))// & + " s) cannot be larger than FAST time step ("//TRIM(Num2LStr(p_FAST%dt))//" s)." + ELSE + ! calculate the number of subcycles: + p_FAST%n_substeps(ModuleID) = NINT( p_FAST%dt / p_FAST%dt_module( ModuleID ) ) + + ! let's make sure THE module DT is an exact integer divisor of the global (FAST) time step: + IF ( .NOT. EqualRealNos( p_FAST%dt, p_FAST%dt_module( ModuleID ) * p_FAST%n_substeps(ModuleID) ) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = "The "//TRIM(y_FAST%Module_Ver(ModuleID)%Name)//" module time step ("//& + TRIM(Num2LStr(p_FAST%dt_module( ModuleID )))// & + " s) must be an integer divisor of the FAST time step ("//TRIM(Num2LStr(p_FAST%dt))//" s)." + END IF + + END IF + END IF + + RETURN + +END SUBROUTINE SetModuleSubstepTime +!---------------------------------------------------------------------------------------------------------------------------------- +!> This writes data to the FAST summary file. +SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs (changes value of UnSum) + TYPE(FAST_ModuleMapType), INTENT(IN) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status (level) + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Message describing error reported in ErrStat + + ! local variables + REAL(ReKi) :: TmpRate ! temporary rate for vtk output + INTEGER(IntKi) :: I ! temporary counter + INTEGER(IntKi) :: J ! temporary counter + INTEGER(IntKi) :: Module_Number ! loop counter through the modules + CHARACTER(200) :: Fmt ! temporary format string + CHARACTER(200) :: DescStr ! temporary string to write text + CHARACTER(*), PARAMETER :: NotUsedTxt = " [not called]" ! text written if a module is not called + CHARACTER(ChanLen) :: ChanTxt(2) ! temp strings to help with formatting with unknown ChanLen size + + ! Get a unit number and open the file: + + CALL GetNewUnit( y_FAST%UnSum, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + CALL OpenFOutFile ( y_FAST%UnSum, TRIM(p_FAST%OutFileRoot)//'.sum', ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! Add some file information: + + !.......................... Module Versions ..................................................... + !bjj: modules in this list are ordered by the order they are specified in the FAST input file + + WRITE (y_FAST%UnSum,'(/A)') 'FAST Summary File' + WRITE (y_FAST%UnSum,'(/A)') TRIM( y_FAST%FileDescLines(1) ) + + WRITE (y_FAST%UnSum,'(2X,A)' ) 'run with' + Fmt = '(4x,A)' + WRITE (y_FAST%UnSum,Fmt) TRIM( GetNVD( NWTC_Ver ) ) + + DO I = 2,NumModules + IF (p_FAST%ModuleInitialized(I)) THEN + WRITE (y_FAST%UnSum,Fmt) TRIM( GetNVD( y_FAST%Module_Ver( I ) ) ) + !ELSE + ! DescStr = GetNVD( y_FAST%Module_Ver( I ) ) + ! WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr )//NotUsedTxt + END IF + END DO + + + + !.......................... Information from FAST input File ...................................... +! OTHER information we could print here: +! current working directory +! output file root name +! output file time step +! output file format (text/binary) +! coupling method + + SELECT CASE ( p_FAST%TurbineType ) + CASE ( Type_LandBased ) + DescStr = 'Modeling a land-based turbine' + CASE ( Type_Offshore_Fixed ) + DescStr = 'Modeling a fixed-bottom offshore turbine' + CASE ( Type_Offshore_Floating ) + DescStr = 'Modeling a floating offshore turbine' + CASE ( Type_MHK_Fixed ) + DescStr = 'Modeling a fixed-bottom MHK turbine' + CASE ( Type_MHK_Floating ) + DescStr = 'Modeling a floating MHK turbine' + CASE DEFAULT ! This should never happen + DescStr="" + END SELECT + WRITE(y_FAST%UnSum,'(//A)') TRIM(DescStr) + + WRITE (y_FAST%UnSum,'(A)' ) 'Description from the FAST input file: ' + WRITE (y_FAST%UnSum,'(2X,A)') TRIM(p_FAST%FTitle) + + !.......................... Requested Features ................................................... + + SELECT CASE ( p_FAST%InterpOrder ) + CASE (0) + DescStr = ' (nearest neighbor)' + CASE (1) + DescStr = ' (linear)' + CASE (2) + DescStr = ' (quadratic)' + CASE DEFAULT + DescStr = ' ( )' + END SELECT + + WRITE(y_FAST%UnSum,'(/A,I1,A)' ) 'Interpolation order for input/output time histories: ', p_FAST%InterpOrder, TRIM(DescStr) + WRITE(y_FAST%UnSum,'( A,I2)' ) 'Number of correction iterations: ', p_FAST%NumCrctn + + + !.......................... Information About Coupling ................................................... + + IF ( ALLOCATED( MeshMapData%Jacobian_Opt1 ) ) then ! we're using option 1 + + IF ( p_FAST%CompSub /= Module_None .OR. p_FAST%CompElast == Module_BD .OR. p_FAST%CompMooring == Module_Orca ) THEN ! SubDyn-BeamDyn-HydroDyn-ElastoDyn-ExtPtfm + DescStr = 'ElastoDyn, SubDyn, HydroDyn, OrcaFlex, ExtPtfm_MCKF, and/or BeamDyn' + ELSE ! IF ( p_FAST%CompHydro == Module_HD ) THEN + DescStr = "ElastoDyn to HydroDyn" + END IF + + WRITE(y_FAST%UnSum,'( A,I6)' ) 'Number of rows in Jacobian matrix used for coupling '//TRIM(DescStr)//': ', & + SIZE(MeshMapData%Jacobian_Opt1, 1) + END IF + + !.......................... Time step information: ................................................... + + WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Time Steps " + WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" + Fmt = '(2X,A17,2X,A15,2X,A13)' + WRITE (y_FAST%UnSum, Fmt ) "Component ", "Time Step (s) ", "Subcycles (-)" + WRITE (y_FAST%UnSum, Fmt ) "-----------------", "---------------", "-------------" + Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,2X,I8,:,A)' + WRITE (y_FAST%UnSum, Fmt ) "FAST (glue code) ", p_FAST%DT + DO Module_Number=2,NumModules ! assumes glue-code is module number 1 (i.e., MODULE_Glue == 1) + IF (p_FAST%ModuleInitialized(Module_Number)) THEN + WRITE (y_FAST%UnSum, Fmt ) y_FAST%Module_Ver(Module_Number)%Name, p_FAST%DT_module(Module_Number), p_FAST%n_substeps(Module_Number) + END IF + END DO + IF ( p_FAST%n_DT_Out == 1_IntKi ) THEN + WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, 1_IntKi ! we'll write "1" instead of "1^-1" + ELSE + WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, p_FAST%n_DT_Out,"^-1" + END IF + + IF (p_FAST%WrVTK == VTK_Animate) THEN + + TmpRate = p_FAST%DT*p_FAST%n_VTKTime + + IF ( p_FAST%n_VTKTime == 1_IntKi ) THEN + WRITE (y_FAST%UnSum, Fmt ) "VTK output files ", p_FAST%DT, 1_IntKi ! we'll write "1" instead of "1^-1" + ELSE + WRITE (y_FAST%UnSum, Fmt ) "VTK output files ", TmpRate, p_FAST%n_VTKTime,"^-1" + END IF + ELSE + TmpRate = p_FAST%VTK_fps + END IF + + ! bjj: fix this; possibly add names of which files will be generated? + IF (p_FAST%WrVTK == VTK_Animate .or. p_FAST%WrVTK == VTK_ModeShapes) THEN + Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' + + WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" + WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" + WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" + END IF + + + !.......................... Requested Output Channels ............................................ + + WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Channels in FAST Output File(s) " + WRITE (y_FAST%UnSum, '(2X,A)') "--------------------------------------------" + Fmt = '(2X,A6,2(2X,A'//TRIM(num2lstr(ChanLen))//'),2X,A)' + ChanTxt(1) = 'Name' + ChanTxt(2) = 'Units' + WRITE (y_FAST%UnSum, Fmt ) "Number", ChanTxt, "Generated by" + ChanTxt = '--------------------' !this ought to be sufficiently long + WRITE (y_FAST%UnSum, Fmt ) "------", ChanTxt, "------------" + + Fmt = '(4X,I4,2(2X,A'//TRIM(num2lstr(ChanLen))//'),2X,A)' + I = 0 + DO Module_Number = 1,NumModules + DO J = 1,y_FAST%numOuts( Module_Number ) + I = I + 1 + WRITE (y_FAST%UnSum, Fmt ) I, y_FAST%ChannelNames(I), y_FAST%ChannelUnits(I), TRIM(y_FAST%Module_Ver( Module_Number )%Name) + END DO + END DO + + + !.......................... End of Summary File ............................................ + + ! bjj: note that I'm not closing the summary file here, though at the present time we don't write to this file again. + ! In the future, we may want to write additional information to this file during the simulation. + ! bjj 4/21/2015: closing the file now because of restart. If it needs to be open later, we can change it again. + + CLOSE( y_FAST%UnSum ) + y_FAST%UnSum = -1 + +END SUBROUTINE FAST_WrSum +!---------------------------------------------------------------------------------------------------------------------------------- + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! TIME-STEP SOLVER ROUTINES (includes initialization after first call to calcOutput at t=0) +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Routine that calls FAST_Solution0 for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) + USE Solver, only: Solver_Step0 + + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Get initial conditions for solver + CALL Solver_Step0(Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + + ! CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& + ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + + CALL WriteOutputToFile(0, Turbine%m_FAST%t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & + Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg) + +END SUBROUTINE FAST_Solution0_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. +SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi), PARAMETER :: n_t_global = -1 ! loop counter + INTEGER(IntKi), PARAMETER :: n_t_global_next = 0 ! loop counter + REAL(DbKi) :: t_initial ! next simulation time (t_global_next) + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution0' + + + !NOTE: m_FAST%t_global is t_initial in this routine + + ErrStat = ErrID_None + ErrMsg = "" + + t_initial = m_FAST%t_global ! which is used in place of t_global_next + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, p_FAST) + + IF (p_FAST%WrSttsTime) then + CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, t_initial, p_FAST%TMax, p_FAST%TDesc ) + END IF + + + ! Solve input-output relations; this section of code corresponds to Eq. (35) in Gasmi et al. (2013) + ! This code will be specific to the underlying modules + + ! the initial ServoDyn and IfW/Lidar inputs from Simulink: + IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + + if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then + ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file + call SeaSt_CalcOutput( t_initial, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (p_FAST%UseSC ) then + call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + !---------------------------------------------------------------------------------------- + ! Check to see if we should output data this time step: + !---------------------------------------------------------------------------------------- + + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! turn off VTK output when + if (p_FAST%WrVTK == VTK_InitOnly) then + ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) + + call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end if + + + !............... + ! Copy values of these initial guesses for interpolation/extrapolation and + ! initialize predicted states for j_pc loop (use MESH_NEWCOPY here so we can use MESH_UPDATE copy later) + !............... + + ! Initialize Input-Output arrays for interpolation/extrapolation: + + CALL FAST_InitIOarrays( m_FAST%t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE FAST_Solution0 +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the input and output arrays stored for extrapolation. They are initialized after the first input-output solve so that the first +!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to +!! be stored for the predictor-corrector loop. +SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i, j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows + ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation + ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as + ! order = SIZE(ED%Input) + + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input(1), ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ED_CopyInput (ED%Input(1), ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + IF (p_FAST%CompElast == Module_BD ) THEN + + DO k = 1,p_FAST%nBeams + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes(j,k) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input(1,k), BD%Input(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL BD_CopyInput (BD%Input(1,k), BD%u(k), MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! nBeams + + END IF ! CompElast + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL SrvD_CopyInput (SrvD%Input(1), SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompServo + + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD14%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL AD14_CopyInput (AD14%Input(1), AD14%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL AD14_CopyInput (AD14%Input(1), AD14%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input(1), AD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL AD_CopyInput (AD%Input(1), AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !IfW%OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL InflowWind_CopyInput (IfW%Input(1), IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !HD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input(1), HD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL HydroDyn_CopyInput (HD%Input(1), HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !SD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input(1), SD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL SD_CopyInput (SD%Input(1), SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !MAP_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL MAP_CopyInput (MAPp%Input(1), MAPp%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN + CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !MD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input(1), MD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL MD_CopyInput (MD%Input(1), MD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL FEAM_CopyInput (FEAM%Input(1), FEAM%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input(1), Orca%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL Orca_CopyInput (Orca%Input(1), Orca%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !IceF_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL IceFloe_CopyInput (IceF%Input(1), IceF%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes(j,i) = t_initial - (j - 1) * p_FAST%dt + !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL IceD_CopyInput (IceD%Input(1,i), IceD%u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Initialize predicted states for j_pc loop: + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + +END SUBROUTINE FAST_InitIOarrays +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + USE Solver, only: Solver_Step + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(dbki) :: t_global_next + t_global_next = t_initial + (n_t_global+1)*Turbine%p_FAST%DT + + ! Get initial conditions for solver + CALL Solver_Step(n_t_global, t_initial, Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + + ! CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & + ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + + CALL WriteOutputToFile(n_t_global + 1, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & + Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SeaSt, Turbine%HD, Turbine%SD, & + Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg) + +END SUBROUTINE FAST_Solution_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine takes data from n_t_global and gets values at n_t_global + 1 +SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed + LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed + + INTEGER(IntKi) :: I, k ! generic loop counters + + !REAL(ReKi) :: ControlInputGuess ! value of controller inputs + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + + + ErrStat = ErrID_None + ErrMsg = "" + ErrStat2 = ErrID_None + ErrMsg2 = "" + + n_t_global_next = n_t_global+1 + t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + + !! determine if the Jacobian should be calculated this time + IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian + + if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then + m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) + else + m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac + end if + + END IF + + ! set number of corrections to be used for this time step: + IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps + if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder + NumCorrections = p_FAST%NumCrctn + elseif (n_t_global == 0) then + NumCorrections = max(p_FAST%NumCrctn,16) + else + NumCorrections = max(p_FAST%NumCrctn,1) + end if + ELSE + NumCorrections = p_FAST%NumCrctn + END IF + + ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from + ! the previous step before we extrapolate these inputs: + IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + + IF ( p_FAST%UseSC ) THEN + CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: Extrapolate Inputs + !! + !! gives predicted values at t+dt + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + !! predictor-corrector loop: + j_pc = 0 + do while (j_pc <= NumCorrections) + WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) + !! + !! STATE_CURR values of x, xd, z, and OtherSt contain values at m_FAST%t_global; + !! STATE_PRED values contain values at t_global_next. + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.c: Input-Output Solve + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! save predicted inputs for comparison with corrected value later + !IF (p_FAST%CheckHSSBrTrqC) THEN + ! ControlInputGuess = ED%Input(1)%HSSBrTrqC + !END IF + + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 2: Correct (continue in loop) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + j_pc = j_pc + 1 + + ! ! Check if the predicted inputs were significantly different than the corrected inputs + ! ! (values before and after CalcOutputs_And_SolveForInputs) + !if (j_pc > NumCorrections) then + ! + ! !if (p_FAST%CheckHSSBrTrqC) then + ! ! if ( abs(ControlInputGuess - ED%Input(1)%HSSBrTrqC) > 50.0_ReKi ) then ! I randomly picked 50 N-m + ! ! NumCorrections = min(p_FAST%NumCrctn + 1, MaxCorrections) + ! ! ! print *, 'correction:', t_global_next, NumCorrections + ! ! cycle + ! ! end if + ! !end if + ! + ! ! check pitch position input to structural code (not implemented, yet) + !end if + + enddo ! j_pc + + if (p_FAST%UseSC ) then + call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then + ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file + call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 3: Save all final variables (advance to next time) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !---------------------------------------------------------------------------------------- + !! copy the final predicted states from step t_global_next to actual states for that step + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! BeamDyn: copy final predictions to actual states + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + + ! AeroDyn: copy final predictions to actual states; copy current outputs to next + IF ( p_FAST%CompAero == Module_AD14 ) THEN + CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! InflowWind: copy final predictions to actual states; copy current outputs to next + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! ServoDyn: copy final predictions to actual states; copy current outputs to next + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! SeaState has no states + + ! HydroDyn: copy final predictions to actual states + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP: copy final predictions to actual states + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! IceFloe: copy final predictions to actual states + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO i=1,p_FAST%numIceLegs + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! We've advanced everything to the next time step: + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !! update the global time + + m_FAST%t_global = t_global_next + + + !---------------------------------------------------------------------------------------- + !! Check to see if we should output data this time step: + !---------------------------------------------------------------------------------------- + CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, & + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !---------------------------------------------------------------------------------------- + !! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------------------- + + IF (p_FAST%WrSttsTime) then + IF ( MOD( n_t_global_next, p_FAST%n_SttsTime ) == 0 ) THEN + CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + + ENDIF + ENDIF + +END SUBROUTINE FAST_Solution +!---------------------------------------------------------------------------------------------------------------------------------- +! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP +!---------------------------------------------------------------------------------------------------------------------------------- +FUNCTION NeedWriteOutput(n_t_global, t_global, p_FAST) + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + + LOGICAL :: NeedWriteOutput !< Function result; if true, WriteOutput values are needed on this time step + + IF ( t_global >= p_FAST%TStart ) THEN ! note that if TStart isn't an multiple of DT_out, we will not necessarially start output to the file at TStart + NeedWriteOutput = MOD( n_t_global, p_FAST%n_DT_Out ) == 0 + ELSE + NeedWriteOutput = .FALSE. + END IF + +END FUNCTION NeedWriteOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine determines if it's time to write to the output files--based on a previous call to fast_subs::needwriteoutput--, and +!! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time +!! have been completed, and assumes y_FAST\%WriteThisStep has been set. +SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, & + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) +!............................................................................................................................... + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + CHARACTER(*), PARAMETER :: RoutineName = 'WriteOutputToFile' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Write time-series channel data + + !y_FAST%WriteThisStep = NeedWriteOutput(n_t_global, t_global, p_FAST) + IF ( y_FAST%WriteThisStep ) THEN + + ! Generate glue-code output file + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%y%WriteOutput, & + AD%y, SrvD%y%WriteOutput, SeaSt%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & + FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) + + ENDIF + + ! Write visualization data (and also note that we're ignoring any errors that occur doing so) + IF ( p_FAST%WrVTK == VTK_Animate ) THEN + IF ( MOD( n_t_global, p_FAST%n_VTKTime ) == 0 ) THEN + call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + END IF + END IF + + +END SUBROUTINE WriteOutputToFile +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes the module output to the primary output file(s). +SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) + + IMPLICIT NONE + + ! Passed variables + REAL(DbKi), INTENT(IN) :: t !< Current simulation time, in seconds + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs + + + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OpFMOutput (:) !< OpenFOAM WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SrvDOutput (:) !< ServoDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SeaStOutput (:) !< SeaState WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: HDOutput (:) !< HydroDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SDOutput (:) !< SubDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtPtfmOutput (:) !< ExtPtfm_MCKF WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: MAPOutput (:) !< MAP WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: FEAMOutput (:) !< FEAMooring WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: MDOutput (:) !< MoorDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OrcaOutput (:) !< OrcaFlex interface WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IceFOutput (:) !< IceFloe WriteOutput values + TYPE(IceD_OutputType), INTENT(IN) :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) + TYPE(BD_OutputType), INTENT(IN) :: y_BD (:) !< BeamDyn outputs (WriteOutput values are subset) + + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + + ! Local variables. + + CHARACTER(200) :: Frmt ! A string to hold a format specifier + CHARACTER(p_FAST%TChanLen) :: TmpStr ! temporary string to print the time output as text + + REAL(ReKi) :: OutputAry(SIZE(y_FAST%ChannelNames)-1) + + ErrStat = ErrID_None + ErrMsg = '' + + CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + + IF (p_FAST%WrTxtOutFile) THEN + + ! Write one line of tabular output: + ! Frmt = '(F8.3,'//TRIM(Num2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' + Frmt = '"'//p_FAST%Delim//'"'//p_FAST%OutFmt ! format for array elements from individual modules + + ! time + WRITE( TmpStr, '('//trim(p_FAST%OutFmt_t)//')' ) t + CALL WrFileNR( y_FAST%UnOu, TmpStr ) + + ! write the individual module output (convert to SiKi if necessary, so that we don't need to print so many digits in the exponent) + CALL WrNumAryFileNR ( y_FAST%UnOu, REAL(OutputAry,SiKi), Frmt, ErrStat, ErrMsg ) + !IF ( ErrStat >= AbortErrLev ) RETURN + + ! write a new line (advance to the next line) + WRITE (y_FAST%UnOu,'()') + + END IF + + + IF (p_FAST%WrBinOutFile) THEN + + ! Write data to array for binary output file + + IF ( y_FAST%n_Out == y_FAST%NOutSteps ) THEN + ErrStat = ErrID_Warn + ErrMsg = 'Not all data could be written to the binary output file.' + !CALL ProgWarn( 'Not all data could be written to the binary output file.' ) + !this really would only happen if we have an error somewhere else, right? + !otherwise, we could allocate a new, larger array and move existing data + ELSE + y_FAST%n_Out = y_FAST%n_Out + 1 + + ! store time data + IF ( y_FAST%n_Out == 1_IntKi .OR. p_FAST%WrBinMod == FileFmtID_WithTime ) THEN + y_FAST%TimeData(y_FAST%n_Out) = t ! Time associated with these outputs + END IF + + ! store individual module data + y_FAST%AllOutData(:, y_FAST%n_Out) = OutputAry + + END IF + + END IF + + RETURN +END SUBROUTINE WrOutputLine +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FillOutputAry for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. (Called from Simulink interface.) +SUBROUTINE FillOutputAry_T(Turbine, Outputs) + + TYPE(FAST_TurbineType), INTENT(IN ) :: Turbine !< all data for one instance of a turbine + REAL(ReKi), INTENT( OUT) :: Outputs(:) !< single array of output + + + CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%OpFM%y%WriteOutput, & + Turbine%ED%y%WriteOutput, Turbine%AD%y, Turbine%SrvD%y%WriteOutput, & + Turbine%SeaSt%y%WriteOutput, Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & + Turbine%FEAM%y%WriteOutput, Turbine%MD%y%WriteOutput, Turbine%Orca%y%WriteOutput, & + Turbine%IceF%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) + +END SUBROUTINE FillOutputAry_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine concatenates all of the WriteOutput values from the module Output into one array to be written to the FAST +!! output file. +SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType),INTENT(IN) :: y_FAST !< Glue-code simulation outputs + + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OpFMOutput (:) !< OpenFOAM WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SrvDOutput (:) !< ServoDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SeaStOutput (:) !< SeaState WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: HDOutput (:) !< HydroDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SDOutput (:) !< SubDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtPtfmOutput (:) !< ExtPtfm_MCKF WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: MAPOutput (:) !< MAP WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: FEAMOutput (:) !< FEAMooring WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: MDOutput (:) !< MoorDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OrcaOutput (:) !< OrcaFlex interface WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IceFOutput (:) !< IceFloe WriteOutput values + TYPE(IceD_OutputType), INTENT(IN) :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) + TYPE(BD_OutputType), INTENT(IN) :: y_BD (:) !< BeamDyn outputs (WriteOutput values are subset) + + REAL(ReKi), INTENT(OUT) :: OutputAry(:) !< single array of output + + INTEGER(IntKi) :: i ! loop counter + INTEGER(IntKi) :: indxLast ! The index of the last row value to be written to AllOutData for this time step (column). + INTEGER(IntKi) :: indxNext ! The index of the next row value to be written to AllOutData for this time step (column). + + + ! store individual module data into one array for output + + indxLast = 0 + indxNext = 1 + + IF (y_FAST%numOuts(Module_Glue) > 1) THEN ! if we output more than just the time channel.... + indxLast = indxNext + SIZE(y_FAST%DriverWriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_IfW) > 0 ) THEN + indxLast = indxNext + SIZE(IfWOutput) - 1 + OutputAry(indxNext:indxLast) = IfWOutput + indxNext = IndxLast + 1 + ELSEIF ( y_FAST%numOuts(Module_OpFM) > 0 ) THEN + indxLast = indxNext + SIZE(OpFMOutput) - 1 + OutputAry(indxNext:indxLast) = OpFMOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_ED) > 0 ) THEN + indxLast = indxNext + SIZE(EDOutput) - 1 + OutputAry(indxNext:indxLast) = EDOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_BD) > 0 ) THEN + do i=1,SIZE(y_BD) + indxLast = indxNext + SIZE(y_BD(i)%WriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_BD(i)%WriteOutput + indxNext = IndxLast + 1 + end do + END IF + + IF ( y_FAST%numOuts(Module_AD) > 0 ) THEN + do i=1,SIZE(y_AD%Rotors) + if (allocated(y_AD%Rotors(i)%WriteOutput)) then + indxLast = indxNext + SIZE(y_AD%Rotors(i)%WriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_AD%Rotors(i)%WriteOutput + indxNext = IndxLast + 1 + endif + end do + END IF + + IF ( y_FAST%numOuts(Module_SrvD) > 0 ) THEN + indxLast = indxNext + SIZE(SrvDOutput) - 1 + OutputAry(indxNext:indxLast) = SrvDOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_SeaSt) > 0 ) THEN + indxLast = indxNext + SIZE(SeaStOutput) - 1 + OutputAry(indxNext:indxLast) = SeaStOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_HD) > 0 ) THEN + indxLast = indxNext + SIZE(HDOutput) - 1 + OutputAry(indxNext:indxLast) = HDOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_SD) > 0 ) THEN + indxLast = indxNext + SIZE(SDOutput) - 1 + OutputAry(indxNext:indxLast) = SDOutput + indxNext = IndxLast + 1 + ELSE IF ( y_FAST%numOuts(Module_ExtPtfm) > 0 ) THEN + indxLast = indxNext + SIZE(ExtPtfmOutput) - 1 + OutputAry(indxNext:indxLast) = ExtPtfmOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_MAP) > 0 ) THEN + indxLast = indxNext + SIZE(MAPOutput) - 1 + OutputAry(indxNext:indxLast) = MAPOutput + indxNext = IndxLast + 1 + ELSEIF ( y_FAST%numOuts(Module_MD) > 0 ) THEN + indxLast = indxNext + SIZE(MDOutput) - 1 + OutputAry(indxNext:indxLast) = MDOutput + indxNext = IndxLast + 1 + ELSEIF ( y_FAST%numOuts(Module_FEAM) > 0 ) THEN + indxLast = indxNext + SIZE(FEAMOutput) - 1 + OutputAry(indxNext:indxLast) = FEAMOutput + indxNext = IndxLast + 1 + ELSEIF ( y_FAST%numOuts(Module_Orca) > 0 ) THEN + indxLast = indxNext + SIZE(OrcaOutput) - 1 + OutputAry(indxNext:indxLast) = OrcaOutput + indxNext = IndxLast + 1 + END IF + + IF ( y_FAST%numOuts(Module_IceF) > 0 ) THEN + indxLast = indxNext + SIZE(IceFOutput) - 1 + OutputAry(indxNext:indxLast) = IceFOutput + indxNext = IndxLast + 1 + ELSEIF ( y_FAST%numOuts(Module_IceD) > 0 ) THEN + DO i=1,p_FAST%numIceLegs + indxLast = indxNext + SIZE(y_IceD(i)%WriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_IceD(i)%WriteOutput + indxNext = IndxLast + 1 + END DO + END IF + +END SUBROUTINE FillOutputAry +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WriteVTK' + + + IF ( p_FAST%VTK_Type == VTK_Surf ) THEN + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN + CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) + CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') + !unOut = -1 + !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !close( unOut ) + END IF + + y_FAST%VTK_count = y_FAST%VTK_count + 1 + +END SUBROUTINE WriteVTK +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes all the committed meshes to VTK-formatted files. It doesn't bother with returning an error code. +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + use FVW_IO, only: WrVTK_FVW + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + +! logical :: outputFields ! flag to determine if we want to output the HD mesh fields + INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: j ! counter for StC instance at location + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_AllMeshes' + + + + NumBl = 0 + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) + end if + + + +! I'm first going to just put all of the meshes that get mapped together, then decide if we're going to print/plot them all + +! ElastoDyn + if (allocated(ED%Input)) then + + ! ElastoDyn outputs (motions) + DO K=1,NumBl + !%BladeLn2Mesh(K) used only when not BD (see below) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + +! these will get output with their sibling input meshes + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + + ! ElastoDyn inputs (loads) + ! %BladePtLoads used only when not BD (see below) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TowerLn2Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%HubPtMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%NacelleMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TFinCMLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TFinCMMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%PlatformPtMesh ) + end if + + +! BeamDyn + IF ( p_FAST%CompElast == Module_BD .and. allocated(BD%Input) .and. allocated(BD%y)) THEN + + do K=1,NumBl + ! BeamDyn inputs + !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end do + if (allocated(MeshMapData%y_BD_BldMotion_4Loads)) then + do K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) + ! skipping PointLoad + end do + elseif (p_FAST%BD_OutputSibling) then + do K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%y(k)%BldMotion ) + ! skipping PointLoad + end do + end if + + do K=1,NumBl + ! BeamDyn outputs + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%VTK_OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%Input(1,k)%RootMotion ) + end do + + if (.not. p_FAST%BD_OutputSibling) then !otherwise this mesh has been put with the DistrLoad mesh + do K=1,NumBl + ! BeamDyn outputs + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end do + end if + + + ELSE if (p_FAST%CompElast == Module_ED .and. allocated(ED%Input)) then + ! ElastoDyn + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%BladeLn2Mesh(K) ) + END DO + END IF + +! ServoDyn + if (allocated(SrvD%Input)) then + IF ( ALLOCATED(SrvD%Input(1)%NStCMotionMesh) ) THEN + do j=1,size(SrvD%Input(1)%NStCMotionMesh) + IF ( SrvD%Input(1)%NStCMotionMesh(j)%Committed ) THEN + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NStCLoadMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NStC'//trim(num2lstr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%NStCMotionMesh(j) ) + ENDIF + enddo + ENDIF + IF ( ALLOCATED(SrvD%Input(1)%TStCMotionMesh) ) THEN + do j=1,size(SrvD%Input(1)%TStCMotionMesh) + IF ( SrvD%Input(1)%TStCMotionMesh(j)%Committed ) THEN + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TStCLoadMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TStC'//trim(num2lstr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TStCMotionMesh(j) ) + ENDIF + enddo + ENDIF + IF ( ALLOCATED(SrvD%Input(1)%BStCMotionMesh) ) THEN + do j=1,size(SrvD%Input(1)%BStCMotionMesh,2) + DO K=1,size(SrvD%Input(1)%BStCMotionMesh,1) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%BStCLoadMesh(k,j), trim(p_FAST%VTK_OutFileRoot)//'.SrvD_BStC'//trim(num2lstr(j))//'B'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%BStCMotionMesh(k,j) ) + ENDDO + enddo + ENDIF + IF ( ALLOCATED(SrvD%Input(1)%SStCMotionMesh) ) THEN + do j=1,size(SrvD%Input(1)%SStCMotionMesh) + IF ( SrvD%Input(1)%SStCMotionMesh(j)%Committed ) THEN + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%SStCLoadMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.SrvD_SStC'//trim(num2lstr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%SStCMotionMesh(j) ) + ENDIF + enddo + ENDIF + end if + + +! AeroDyn + IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN + if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors) ) then + if (allocated(AD%Input(1)%rotors(1)%BladeRootMotion)) then + + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%BladeMotion(k) ) + END DO + call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%TowerMotion ) + + end if + end if + + ! FVW submodule of AD15 + if (allocated(AD%m%FVW_u)) then + if (allocated(AD%m%FVW_u(1)%WingsMesh)) then + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%m%FVW_u(1)%WingsMesh(k), trim(p_FAST%VTK_OutFileRoot)//'.FVW_WingsMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%BladeMotion(k) ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + END DO + ! Free wake + call WrVTK_FVW(AD%p%FVW, AD%x(1)%FVW, AD%z(1)%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', y_FAST%VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + end if + end if + END IF + +! HydroDyn + IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%PRPMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_PRP', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%WamitMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%WAMITMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Morison', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%Mesh ) + END IF + +! SubDyn + IF ( p_FAST%CompSub == Module_SD .and. allocated(SD%Input)) THEN + !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%y%y2Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_LMesh_y3Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%y%y3Mesh ) + + call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%Input(1)%TPMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm .and. allocated(ExtPtfm%Input)) THEN + call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ExtPtfm%Input(1)%PtfmMesh ) + END IF + +! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + if (allocated(MAPp%Input)) then + call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MAPp%Input(1)%PtFairDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + +! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + if (allocated(MD%Input) .and. allocated(MD%y%CoupledLoads)) then + call MeshWrVTK(p_FAST%TurbinePos, MD%y%CoupledLoads(1), trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%CoupledKinematics(1) ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + +! FEAMooring + ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + if (allocated(FEAM%Input)) then + call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, FEAM%Input(1)%PtFairleadDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + +! Orca + ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + if (allocated(Orca%Input)) then + call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Orca%Input(1)%PtfmMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + END IF + + +! IceFloe + IF ( p_FAST%CompIce == Module_IceF ) THEN + if (allocated(IceF%Input)) then + call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceF%Input(1)%iceMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + +! IceDyn + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + if (allocated(IceD%Input) .and. allocated(IceD%y)) then + + DO k = 1,p_FAST%numIceLegs + call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceD%Input(1,k)%PointMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + end if + + END IF + + +END SUBROUTINE WrVTK_AllMeshes +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes a minimal subset of meshes (enough to visualize the turbine) to VTK-formatted files. It doesn't bother with +!! returning an error code. +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_BasicMeshes' + + + NumBl = 0 + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) + end if + + +! Blades + IF ( p_FAST%CompAero == Module_AD .and. ALLOCATED(AD%Input) ) THEN ! These meshes may have airfoil data associated with nodes... + if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors)) then + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%rotors(1)%BladeLoad(K) ) + END DO + end if + ELSE IF ( p_FAST%CompElast == Module_BD .and. ALLOCATED(BD%y)) THEN + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + END DO + END IF + + if (allocated(ED%Input)) then + ! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%NacelleLoads ) + ! TailFin + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%TFinCMLoads ) + ! Hub + call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%HubPtLoad ) + ! Tower motions + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + + + +! Substructure +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! IF ( p_FAST%CompSub == Module_SD ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! END IF + + IF ( p_FAST%CompHydro == Module_HD .and. ALLOCATED(HD%Input)) THEN + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%WAMITMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%WAMITMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Morison', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%Morison%Mesh ) + END IF + + +! Mooring Lines? +! IF ( p_FAST%CompMooring == Module_MAP ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! END IF + + +END SUBROUTINE WrVTK_BasicMeshes +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with +!! returning an error code. +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + use FVW_IO, only: WrVTK_FVW + + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + + logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields + INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' + + NumBl = 0 + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) + end if + +! Ground (written at initialization) + +! Wave elevation + if ( allocated( p_FAST%VTK_Surface%WaveElev ) ) call WrVTK_WaveElev( t_global, p_FAST, y_FAST, SeaSt) + + if (allocated(ED%Input)) then + ! Nacelle + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.NacelleSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) + ! TailFin TODO TailFin + !call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.TailFinSurface', & + ! y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%TFinBox, Sib=ED%Input(1)%TFinCMLoads ) + + ! Hub + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.HubSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & + NumSegments=p_FAST%VTK_Surface%NumSectors, radius=p_FAST%VTK_Surface%HubRad, Sib=ED%Input(1)%HubPtLoad ) + + ! Tower motions + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + end if + +! Blades + IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN ! These meshes may have airfoil data associated with nodes... + if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors)) then + DO K=1,NumBl + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & + ,Sib=AD%y%rotors(1)%BladeLoad(k) ) + END DO + end if + ELSE IF ( p_FAST%CompElast == Module_BD .and. allocated(BD%y)) THEN + DO K=1,NumBl + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + END DO + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN + DO K=1,NumBl + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + END DO + END IF + +! Free wake + if (allocated(AD%m%FVW_u)) then + if (allocated(AD%m%FVW_u(1)%WingsMesh)) then + call WrVTK_FVW(AD%p%FVW, AD%x(1)%FVW, AD%z(1)%FVW, AD%m%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', y_FAST%VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + end if + end if + + +! Platform +! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) + + +! Substructure +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! IF ( p_FAST%CompSub == Module_SD ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! END IF +!TODO: Fix below section for new Morison GJH 4/23/20 + ! + !IF ( HD%Input(1)%Morison%Mesh%Committed ) THEN + ! !if ( p_FAST%CompSub == Module_NONE ) then ! floating + ! ! OutputFields = .false. + ! !else + ! ! OutputFields = p_FAST%VTK_fields + ! !end if + ! + ! call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.MorisonSurface', & + ! y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, & + ! p_FAST%VTK_Surface%MorisonRad, Sib=HD%y%Morison%Mesh ) + !END IF + + +! Mooring Lines? +! IF ( p_FAST%CompMooring == Module_MAP ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! END IF + + + if (p_FAST%VTK_fields) then + call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + end if + + +END SUBROUTINE WrVTK_Surfaces +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine writes the wave elevation data for a given time step +SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, SeaSt) + + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data + + ! local variables + INTEGER(IntKi) :: Un ! fortran unit number + INTEGER(IntKi) :: n, iy, ix ! loop counters + REAL(SiKi) :: t + CHARACTER(1024) :: FileName + INTEGER(IntKi) :: NumberOfPoints + INTEGER(IntKi), parameter :: NumberOfLines = 0 + INTEGER(IntKi) :: NumberOfPolys + CHARACTER(1024) :: Tstr + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElev' + + + NumberOfPoints = size(p_FAST%VTK_surface%WaveElevXY,2) + ! I'm going to make triangles for now. we should probably just make this a structured file at some point + NumberOfPolys = ( p_FAST%VTK_surface%NWaveElevPts(1) - 1 ) * & + ( p_FAST%VTK_surface%NWaveElevPts(2) - 1 ) * 2 + + !................................................................. + ! write the data that potentially changes each time step: + !................................................................. + ! construct the string for the zero-padded VTK write-out step + write(Tstr, '(i' // trim(Num2LStr(p_FAST%VTK_tWidth)) //'.'// trim(Num2LStr(p_FAST%VTK_tWidth)) // ')') y_FAST%VTK_count + + ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file + FileName = TRIM(p_FAST%VTK_OutFileRoot)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' + + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat2, ErrMsg2 ) + if (ErrStat2 >= AbortErrLev) return + +! points (nodes, augmented with NumSegments): + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value + t = REAL(t_global,SiKi) + call GetWaveElevIndx( t, SeaSt%p%WaveTime, y_FAST%VTK_LastWaveIndx ) + + n = 1 + do ix=1,p_FAST%VTK_surface%NWaveElevPts(1) + do iy=1,p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,VTK_AryFmt) p_FAST%VTK_surface%WaveElevXY(:,n), p_FAST%VTK_surface%WaveElev(y_FAST%VTK_LastWaveIndx,n) + n = n+1 + end do + end do + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + do ix=1,p_FAST%VTK_surface%NWaveElevPts(1)-1 + do iy=1,p_FAST%VTK_surface%NWaveElevPts(2)-1 + n = p_FAST%VTK_surface%NWaveElevPts(1)*(ix-1)+iy - 1 ! points start at 0 + + WRITE(Un,'(3(i7))') n, n+1, n+p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,'(3(i7))') n+1, n+1+p_FAST%VTK_surface%NWaveElevPts(2), n+p_FAST%VTK_surface%NWaveElevPts(2) + + end do + end do + WRITE(Un,'(A)') ' ' + + WRITE(Un,'(A)') ' ' + do n=1,NumberOfPolys + WRITE(Un,'(i7)') 3*n + end do + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + + call WrVTK_footer( Un ) + +END SUBROUTINE WrVTK_WaveElev +!---------------------------------------------------------------------------------------------------------------------------------- +!> This function returns the index, Ind, of the XAry closest to XValIn, where XAry is assumed to be periodic. It starts +!! searching at the value of Ind from a previous step. +SUBROUTINE GetWaveElevIndx( XValIn, XAry, Ind ) + + ! Argument declarations. + + INTEGER, INTENT(INOUT) :: Ind ! Initial and final index into the arrays. + + REAL(SiKi), INTENT(IN) :: XAry (:) !< Array of X values to be interpolated. + REAL(SiKi), INTENT(IN) :: XValIn !< X value to be found + + + INTEGER :: AryLen ! Length of the arrays. + REAL(SiKi) :: XVal !< X to be found (wrapped/periodic) + + + AryLen = size(XAry) + + ! Wrap XValIn into the range XAry(1) to XAry(AryLen) + XVal = MOD(XValIn, XAry(AryLen)) + + + + ! Let's check the limits first. + + IF ( XVal <= XAry(1) ) THEN + Ind = 1 + RETURN + ELSE IF ( XVal >= XAry(AryLen) ) THEN + Ind = AryLen + RETURN + ELSE + ! Set the Ind to the first index if we are at the beginning of XAry + IF ( XVal <= XAry(2) ) THEN + Ind = 1 + END IF + END IF + + + ! Let's interpolate! + + Ind = MAX( MIN( Ind, AryLen-1 ), 1 ) + + DO + + IF ( XVal < XAry(Ind) ) THEN + + Ind = Ind - 1 + + ELSE IF ( XVal >= XAry(Ind+1) ) THEN + + Ind = Ind + 1 + + ELSE + + ! XAry(Ind) <= XVal < XAry(Ind+1) + ! this would make it the "closest" node, but I'm not going to worry about that for visualization purposes + !if ( XVal > (XAry(Ind+1) + XAry(Ind))/2.0_SiKi ) Ind = Ind + 1 + + RETURN + + END IF + + END DO + + RETURN +END SUBROUTINE GetWaveElevIndx +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes Input Mesh information to a binary file (for debugging). It both opens and closes the file. +SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, ErrStat, ErrMsg) + TYPE(ED_InputType), INTENT(IN) :: u_ED !< ElastoDyn inputs + TYPE(AD_InputType), INTENT(IN) :: u_AD !< AeroDyn inputs + TYPE(SD_InputType), INTENT(IN) :: u_SD !< SubDyn inputs + TYPE(HydroDyn_InputType), INTENT(IN) :: u_HD !< HydroDyn inputs + TYPE(MAP_InputType), INTENT(IN) :: u_MAP !< MAP inputs + TYPE(BD_InputType), INTENT(IN) :: u_BD(:) !< BeamDyn inputs + CHARACTER(*), INTENT(IN) :: FileName !< Name of file to write this information to + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: unOut + INTEGER(IntKi) :: K_local + INTEGER(B4Ki), PARAMETER :: File_ID = 3 + INTEGER(B4Ki) :: NumBl + + ! Open the binary output file: + unOut=-1 + CALL GetNewUnit( unOut, ErrStat, ErrMsg ) + CALL OpenBOutFile ( unOut, TRIM(FileName), ErrStat, ErrMsg ) + IF (ErrStat /= ErrID_None) RETURN + + ! note that I'm not doing anything with the errors here, so it won't tell + ! you there was a problem writing the data unless it was the last call. + + ! Add a file identification number (in case we ever have to change this): + WRITE( unOut, IOSTAT=ErrStat ) File_ID + + ! Add how many blade meshes there are: + NumBl = SIZE(u_ED%BladePtLoads,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + + ! Add all of the input meshes: + DO K_local = 1,NumBl + CALL MeshWrBin( unOut, u_ED%BladePtLoads(K_local), ErrStat, ErrMsg ) + END DO + CALL MeshWrBin( unOut, u_ED%TowerPtLoads, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_ED%PlatformPtMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_SD%TPMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_SD%LMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_HD%Morison%Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_HD%WAMITMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_MAP%PtFairDisplacement, ErrStat, ErrMsg ) + ! Add how many BD blade meshes there are: + NumBl = SIZE(u_BD,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + + DO K_local = 1,NumBl + CALL MeshWrBin( unOut, u_BD(K_local)%RootMotion, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_BD(K_local)%DistrLoad, ErrStat, ErrMsg ) + END DO + + ! Add how many AD blade meshes there are: + NumBl = SIZE(u_AD%rotors(1)%BladeMotion,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + + DO K_local = 1,NumBl + CALL MeshWrBin( unOut, u_AD%rotors(1)%BladeMotion(k_local), ErrStat, ErrMsg ) + END DO + + ! Close the file + CLOSE(unOut) + +END SUBROUTINE WriteInputMeshesToFile +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes motion mesh data to a binary file (for rudimentary visualization and debugging). If unOut < 0, a new file +!! will be opened for writing (FileName). It is up to the caller of this routine to close the file. +SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_BD, UnOut, ErrStat, ErrMsg, FileName) + REAL(DbKi), INTENT(IN) :: time !< current simulation time + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< ElastoDyn outputs + TYPE(SD_InputType), INTENT(IN) :: u_SD !< SubDyn inputs + TYPE(SD_OutputType), INTENT(IN) :: y_SD !< SubDyn outputs + TYPE(HydroDyn_InputType), INTENT(IN) :: u_HD !< HydroDyn inputs + TYPE(MAP_InputType), INTENT(IN) :: u_MAP !< MAP inputs + TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BeamDyn outputs + TYPE(BD_InputType), INTENT(IN) :: u_BD(:) !< BeamDyn inputs + INTEGER(IntKi) , INTENT(INOUT) :: unOut !< Unit number to write where this info should be written. If unOut < 0, a new file will be opened and the opened unit number will be returned. + CHARACTER(*), INTENT(IN) :: FileName !< If unOut < 0, FileName will be opened for writing this mesh information. + + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + REAL(R8Ki) :: t + + INTEGER(IntKi) :: K_local + INTEGER(B4Ki), PARAMETER :: File_ID = 101 + INTEGER(B4Ki) :: NumBl + + t = time ! convert to 8-bytes if necessary (DbKi might not be R8Ki) + + ! note that I'm not doing anything with the errors here, so it won't tell + ! you there was a problem writing the data unless it was the last call. + + + ! Open the binary output file and write a header: + if (unOut<0) then + CALL GetNewUnit( unOut, ErrStat, ErrMsg ) + + CALL OpenBOutFile ( unOut, TRIM(FileName), ErrStat, ErrMsg ) + IF (ErrStat /= ErrID_None) RETURN + + ! Add a file identification number (in case we ever have to change this): + WRITE( unOut, IOSTAT=ErrStat ) File_ID + + ! Add how many blade meshes there are: + NumBl = SIZE(y_ED%BladeLn2Mesh,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + NumBl = SIZE(y_BD,1) ! Note that NumBl is B4Ki + WRITE( unOut, IOSTAT=ErrStat ) NumBl + end if + + WRITE( unOut, IOSTAT=ErrStat ) t + + ! Add all of the meshes with motions: + DO K_local = 1,SIZE(y_ED%BladeLn2Mesh,1) + CALL MeshWrBin( unOut, y_ED%BladeLn2Mesh(K_local), ErrStat, ErrMsg ) + END DO + CALL MeshWrBin( unOut, y_ED%TowerLn2Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, y_ED%PlatformPtMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_SD%TPMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, y_SD%y2Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, y_SD%y3Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_HD%Morison%Mesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_HD%WAMITMesh, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, u_MAP%PtFairDisplacement, ErrStat, ErrMsg ) + DO K_local = 1,SIZE(y_BD,1) + CALL MeshWrBin( unOut, u_BD(K_local)%RootMotion, ErrStat, ErrMsg ) + CALL MeshWrBin( unOut, y_BD(K_local)%BldMotion, ErrStat, ErrMsg ) + END DO + + ! + ! ! Close the file + !CLOSE(unOut) + ! +END SUBROUTINE WriteMotionMeshesToFile +!---------------------------------------------------------------------------------------------------------------------------------- + + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! Linerization routines +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Routine that calls FAST_Linearize_T for an array of Turbine data structures if the linearization flag is set for each individual turbine. +SUBROUTINE FAST_Linearize_Tary(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine(:) !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i_turb, NumTurbines + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_Tary' + + + NumTurbines = SIZE(Turbine) + ErrStat = ErrID_None + ErrMsg = "" + + DO i_turb = 1,NumTurbines + + CALL FAST_Linearize_T(t_initial, n_t_global, Turbine(i_turb), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + END DO + + +END SUBROUTINE FAST_Linearize_Tary +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that performs lineaization at an operating point for a turbine. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: t_global ! current simulation time + REAL(DbKi) :: next_lin_time ! next simulation time where linearization analysis should be performed + INTEGER(IntKi) :: iLinTime ! loop counter + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + + + ErrStat = ErrID_None + ErrMsg = "" + + if ( .not. Turbine%p_FAST%Linearize ) return + + if (.not. Turbine%p_FAST%CalcSteady) then + + if ( Turbine%m_FAST%Lin%NextLinTimeIndx <= Turbine%p_FAST%NLinTimes ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? + + next_lin_time = Turbine%m_FAST%Lin%LinTimes( Turbine%m_FAST%Lin%NextLinTimeIndx ) + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + + if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then + if (Turbine%m_FAST%Lin%NextLinTimeIndx > Turbine%p_FAST%NLinTimes) call WrVTKCheckpoint() + end if + + end if + + end if + + else ! CalcSteady + + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + + call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%m_FAST%Lin%FoundSteady) then + if (Turbine%m_FAST%Lin%ForceLin) then + Turbine%p_FAST%NLinTimes=1 + endif + + do iLinTime=1,Turbine%p_FAST%NLinTimes + t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) + + call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then + Turbine%m_FAST%calcJacobian = .true. + Turbine%m_FAST%NextJacCalcTime = t_global + end if + + CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & + Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + end do + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) CALL WrVTKCheckpoint() + + if (Turbine%m_FAST%Lin%ForceLin) then + ErrStat2 = ErrID_Warn + ErrMsg2 = 'Linearization was forced at simulation end. The linearized model may not be sufficiently representative of the solution in steady state.' + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif + + end if + + end if + return + +contains + subroutine WrVTKCheckpoint() + ! we are creating a checkpoint file for each turbine, so setting NumTurbines=1 in the file + CALL FAST_CreateCheckpoint_T(t_initial, Turbine%p_FAST%n_TMax_m1+1, 1, Turbine, TRIM(Turbine%p_FAST%OutFileRoot)//'.ModeShapeVTK', ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine WrVTKCheckpoint +END SUBROUTINE FAST_Linearize_T +!---------------------------------------------------------------------------------------------------------------------------------- + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! PROGRAM EXIT ROUTINES +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Routine that calls ExitThisProgram for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +!! This routine should be called from glue code only (e.g., FAST_Prog.f90). It should not be called in any of these driver routines. +SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) + + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< Data for one turbine instance + INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) + LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) + CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats + + LOGICAL :: SkipRunTimes + INTEGER(IntKi) :: ErrStat + CHARACTER(ErrMsgLen) :: ErrMsg + + IF (PRESENT(SkipRunTimeMsg)) THEN + SkipRunTimes = SkipRunTimeMsg + ELSE + SkipRunTimes = .FALSE. + END IF + + + IF (PRESENT(ErrLocMsg)) THEN + + CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) + + ELSE + + CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) + + END IF + + + CALL FAST_DestroyTurbineType( Turbine, ErrStat, ErrMsg) ! just in case we missed some data in ExitThisProgram() + + +END SUBROUTINE ExitThisProgram_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is called when FAST exits. It calls all the modules' end routines and cleans up variables declared in the +!! main program. If there was an error, it also aborts. Otherwise, it prints the run times and performs a normal exit. +!! This routine should not be called from glue code (e.g., FAST_Prog.f90) or ExitThisProgram_T only. It should not be called in any +!! of these driver routines. +SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) +!............................................................................................................................... + + ! Passed arguments + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) + LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) + CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats + + + ! Local variables: + INTEGER(IntKi) :: ErrorLevel + LOGICAL :: PrintRunTimes + + INTEGER(IntKi) :: ErrStat2 ! Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message + CHARACTER(1224) :: SimMsg ! optional message to print about where the error took place in the simulation + + CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' + + + ErrorLevel = ErrLevel_in + + ! for debugging, let's output the meshes and all of their fields + IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None .and. .not. m_FAST%Lin%FoundSteady) THEN + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' + p_FAST%VTK_fields = .true. + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + end if + + + + ! End all modules + CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + IF (ErrStat2 /= ErrID_None) THEN + CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) + ErrorLevel = MAX(ErrorLevel,ErrStat2) + END IF + + ! Destroy all data associated with FAST variables: + + CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + IF (ErrStat2 /= ErrID_None) THEN + CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) + ErrorLevel = MAX(ErrorLevel,ErrStat2) + END IF + + + !............................................................................................................................ + ! Set exit error code if there was an error; + !............................................................................................................................ + IF ( ErrorLevel >= AbortErrLev ) THEN + + IF (PRESENT(ErrLocMsg)) THEN + SimMsg = ErrLocMsg + ELSE + SimMsg = 'after the simulation completed' + END IF + + IF (y_FAST%UnSum > 0) THEN + CLOSE(y_FAST%UnSum) + y_FAST%UnSum = -1 + END IF + + + SimMsg = TRIM(FAST_Ver%Name)//' encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) + if (StopTheProgram) then + CALL ProgAbort( trim(SimMsg), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) + else + CALL WrScr(trim(SimMsg)) + end if + + END IF + + !............................................................................................................................ + ! Write simulation times and stop + !............................................................................................................................ + if (present(SkipRunTimeMsg)) then + PrintRunTimes = .not. SkipRunTimeMsg + else + PrintRunTimes = .true. + end if + + IF (p_FAST%WrSttsTime .and. PrintRunTimes) THEN + CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, UnSum=y_FAST%UnSum, DescStrIn=p_FAST%TDesc ) + END IF + IF (y_FAST%UnSum > 0) THEN + CLOSE(y_FAST%UnSum) + y_FAST%UnSum = -1 + END IF + + if (StopTheProgram) then +#if (defined COMPILE_SIMULINK || defined COMPILE_LABVIEW) + ! for Simulink, this may not be a normal stop. It might call this after an error in the model. + CALL WrScr( NewLine//' '//TRIM(FAST_Ver%Name)//' completed.'//NewLine ) +#else + CALL NormStop( ) +#endif + end if + + +END SUBROUTINE ExitThisProgram +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is called at program termination. It writes any additional output files, +!! deallocates variables for FAST file I/O and closes files. +SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< FAST Parameters + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< FAST Output + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables (only for the final time) + + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Message associated with errro status + + ! local variables + CHARACTER(LEN(y_FAST%FileDescLines)*3) :: FileDesc ! The description of the run, to be written in the binary output file + + + ! Initialize some values + + ErrStat = ErrID_None + ErrMsg = '' + + !------------------------------------------------------------------------------------------------- + ! Write the binary output file if requested + !------------------------------------------------------------------------------------------------- + + IF (p_FAST%WrBinOutFile .AND. y_FAST%n_Out > 0) THEN + + FileDesc = TRIM(y_FAST%FileDescLines(1))//' '//TRIM(y_FAST%FileDescLines(2))//'; '//TRIM(y_FAST%FileDescLines(3)) + + CALL WrBinFAST(TRIM(p_FAST%OutFileRoot)//'.outb', Int(p_FAST%WrBinMod, B2Ki), TRIM(FileDesc), & + y_FAST%ChannelNames, y_FAST%ChannelUnits, y_FAST%TimeData, y_FAST%AllOutData(:,1:y_FAST%n_Out), ErrStat, ErrMsg) + + IF ( ErrStat /= ErrID_None ) CALL WrScr( TRIM(GetErrStr(ErrStat))//' when writing binary output file: '//TRIM(ErrMsg) ) + + END IF + + + !------------------------------------------------------------------------------------------------- + ! Close the text tabular output file and summary file (if opened) + !------------------------------------------------------------------------------------------------- + IF (y_FAST%UnOu > 0) THEN ! I/O unit number for the tabular output file + CLOSE( y_FAST%UnOu ) + y_FAST%UnOu = -1 + END IF + + IF (y_FAST%UnSum > 0) THEN ! I/O unit number for the tabular output file + CLOSE( y_FAST%UnSum ) + y_FAST%UnSum = -1 + END IF + + IF (y_FAST%UnGra > 0) THEN ! I/O unit number for the graphics output file + CLOSE( y_FAST%UnGra ) + y_FAST%UnGra = -1 + END IF + + !------------------------------------------------------------------------------------------------- + ! Deallocate arrays + !------------------------------------------------------------------------------------------------- + + ! Output + IF ( ALLOCATED(y_FAST%AllOutData ) ) DEALLOCATE(y_FAST%AllOutData ) + IF ( ALLOCATED(y_FAST%TimeData ) ) DEALLOCATE(y_FAST%TimeData ) + IF ( ALLOCATED(y_FAST%ChannelNames ) ) DEALLOCATE(y_FAST%ChannelNames ) + IF ( ALLOCATED(y_FAST%ChannelUnits ) ) DEALLOCATE(y_FAST%ChannelUnits ) + + +END SUBROUTINE FAST_EndOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calls the end routines for each module that was previously initialized. +SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i, k ! loop counter + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_EndMods' + + !............................................................................................................................... + ! End all modules (and write binary FAST output file) + !............................................................................................................................... + + ErrStat = ErrID_None + ErrMsg = "" + + + CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN + CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_BD) ) THEN + + DO k=1,p_FAST%nBeams + CALL BD_End(BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + END IF + + + IF ( p_FAST%ModuleInitialized(Module_AD14) ) THEN + CALL AD14_End( AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & + AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%ModuleInitialized(Module_AD) ) THEN + CALL AD_End( AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_IfW) ) THEN + CALL InflowWind_End( IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & + IfW%y, IfW%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_SrvD) ) THEN + CALL SrvD_End( SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & + SrvD%y, SrvD%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_HD) ) THEN + CALL HydroDyn_End( HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y, HD%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_SD) ) THEN + CALL SD_End( SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), & + SD%y, SD%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSE IF ( p_FAST%ModuleInitialized(Module_ExtPtfm) ) THEN + CALL ExtPtfm_End( ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), & + ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_MAP) ) THEN + CALL MAP_End( MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%ModuleInitialized(Module_MD) ) THEN + CALL MD_End( MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & + MD%y, MD%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%ModuleInitialized(Module_FEAM) ) THEN + CALL FEAM_End( FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & + FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%ModuleInitialized(Module_Orca) ) THEN + CALL Orca_End( Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & + Orca%y, Orca%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%ModuleInitialized(Module_IceF) ) THEN + CALL IceFloe_End(IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & + IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%ModuleInitialized(Module_IceD) ) THEN + + DO i=1,p_FAST%numIceLegs + CALL IceD_End(IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & + IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + END IF + +END SUBROUTINE FAST_EndMods +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calls the destroy routines for each module. (It is basically a duplicate of FAST_DestroyTurbineType().) +SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAll' + + + + ! ------------------------------------------------------------------------- + ! Deallocate/Destroy structures associated with mesh mapping + ! ------------------------------------------------------------------------- + + ErrStat = ErrID_None + ErrMsg = "" + + + ! FAST + CALL FAST_DestroyParam( p_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL FAST_DestroyOutputFileType( y_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL FAST_DestroyMisc( m_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! ElastoDyn + CALL FAST_DestroyElastoDyn_Data( ED, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! BeamDyn + CALL FAST_DestroyBeamDyn_Data( BD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! ServoDyn + CALL FAST_DestroyServoDyn_Data( SrvD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AeroDyn14 + CALL FAST_DestroyAeroDyn14_Data( AD14, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AeroDyn + CALL FAST_DestroyAeroDyn_Data( AD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! InflowWind + CALL FAST_DestroyInflowWind_Data( IfW, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! OpenFOAM + CALL FAST_DestroyOpenFOAM_Data( OpFM, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SeaState + CALL FAST_DestroySeaState_Data( SeaSt, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HydroDyn + CALL FAST_DestroyHydroDyn_Data( HD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SubDyn + CALL FAST_DestroySubDyn_Data( SD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! ExtPtfm + CALL FAST_DestroyExtPtfm_Data( ExtPtfm, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! MAP + CALL FAST_DestroyMAP_Data( MAPp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! FEAMooring + CALL FAST_DestroyFEAMooring_Data( FEAM, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! MoorDyn + CALL FAST_DestroyMoorDyn_Data( MD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Orca + CALL FAST_DestroyOrcaFlex_Data( Orca, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! IceFloe + CALL FAST_DestroyIceFloe_Data( IceF, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! IceDyn + CALL FAST_DestroyIceDyn_Data( IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Module (Mesh) Mapping data + CALL FAST_DestroyModuleMapType( MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + + + END SUBROUTINE FAST_DestroyAll +!---------------------------------------------------------------------------------------------------------------------------------- + + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! CHECKPOINT/RESTART ROUTINES +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Routine that calls FAST_CreateCheckpoint_T for an array of Turbine data structures. +SUBROUTINE FAST_CreateCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine(:) !< all data for all turbines + CHARACTER(*), INTENT(IN ) :: CheckpointRoot !< Rootname of checkpoint file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: NumTurbines ! Number of turbines in this simulation + INTEGER(IntKi) :: i_turb + INTEGER :: Unit + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CreateCheckpoint_Tary' + + + NumTurbines = SIZE(Turbine) + ErrStat = ErrID_None + ErrMsg = "" + + ! TRIM(CheckpointRoot)//'.'//TRIM(Num2LStr(Turbine%TurbID))// + + !! This allows us to put all the turbine data in one file. + Unit = -1 + DO i_turb = 1,NumTurbines + CALL FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine(i_turb), CheckpointRoot, ErrStat2, ErrMsg2, Unit ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) then + if (Unit > 0) close(Unit) + RETURN + end if + + END DO + + +END SUBROUTINE FAST_CreateCheckpoint_Tary +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that packs all of the data from one turbine instance into arrays and writes checkpoint files. If Unit is present and +!! greater than 0, it will append the data to an already open file. Otherwise, it opens a new file and writes header information +!! before writing the turbine data to the file. +SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) + + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_CHECKPOINT + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: NumTurbines !< Number of turbines in this simulation + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine (INTENT(OUT) only because of hack for Bladed DLL) + CHARACTER(*), INTENT(IN ) :: CheckpointRoot !< Rootname of checkpoint file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file + + ! local variables: + 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 + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CreateCheckpoint_T' + + CHARACTER(1024) :: FileName ! Name of the (output) checkpoint file + CHARACTER(1024) :: DLLFileName ! Name of the (output) checkpoint file + + ! init error status + ErrStat = ErrID_None + ErrMsg = "" + + ! Initialize the pack buffer + call InitPackBuffer(Buf, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + ! Get the arrays of data to be stored in the output file + call FAST_PackTurbineType(Buf, Turbine) + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + FileName = TRIM(CheckpointRoot)//'.chkp' + DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' + + unOut=-1 + IF (PRESENT(Unit)) unOut = Unit + + IF ( unOut < 0 ) THEN + + CALL GetNewUnit( unOut, ErrStat2, ErrMsg2 ) + CALL OpenBOutFile ( unOut, FileName, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) then + + IF (.NOT. PRESENT(Unit)) THEN + CLOSE(unOut) + unOut = -1 + end if + return + end if + + ! 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: + 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, & + ! Turbine%HD, Turbine%SD, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + ! 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 + END IF + + IF (PRESENT(Unit)) Unit = unOut + + ! A hack to pack Bladed-style DLL data + IF (Turbine%SrvD%p%UseBladedInterface) THEN + if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then + ! store value to be overwritten + old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) + FileName = Turbine%SrvD%m%dll_data%DLL_InFile + ! overwrite values: + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_CHECKPOINT + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! put values back: + Turbine%SrvD%m%dll_data%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + end if + END IF + +END SUBROUTINE FAST_CreateCheckpoint_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_RestoreFromCheckpoint_T for an array of Turbine data structures. +SUBROUTINE FAST_RestoreFromCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time (for comparing with time from checkpoint file) + INTEGER(IntKi), INTENT( OUT) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine(:) !< all data for one instance of a turbine !intent(INOUT) instead of (IN) to attempt to avoid memory warnings in gnu compilers + CHARACTER(*), INTENT(IN ) :: CheckpointRoot !< Rootname of checkpoint file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: t_initial_out + INTEGER(IntKi) :: NumTurbines_out + INTEGER(IntKi) :: NumTurbines ! Number of turbines in this simulation + INTEGER(IntKi) :: i_turb + INTEGER :: Unit + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreFromCheckpoint_Tary' + + + NumTurbines = SIZE(Turbine) + ErrStat = ErrID_None + ErrMsg = "" + + ! Init NWTC_Library, display copyright and version information: + CALL FAST_ProgStart( FAST_Ver ) + + ! Restore data from checkpoint file + Unit = -1 + DO i_turb = 1,NumTurbines + CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(i_turb), CheckpointRoot, ErrStat2, ErrMsg2, Unit ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) + IF (NumTurbines_out /= NumTurbines) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + END DO + + CALL WrScr( ' Restarting simulation at '//TRIM(Num2LStr(n_t_global*Turbine(1)%p_FAST%DT))//' seconds.' ) + + +END SUBROUTINE FAST_RestoreFromCheckpoint_Tary +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is the inverse of FAST_CreateCheckpoint_T. It reads data from a checkpoint file and populates data structures for +!! the turbine instance. +SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_RESTARTING + + REAL(DbKi), INTENT(INOUT) :: t_initial !< initial time + INTEGER(IntKi), INTENT(INOUT) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(INOUT) :: NumTurbines !< Number of turbines in this simulation + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine (bjj: note that is intent INOUT instead of OUT only because of a gfortran compiler memory issue) + CHARACTER(*), INTENT(IN ) :: CheckpointRoot !< Rootname of checkpoint file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file + + ! local variables: + 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 + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreFromCheckpoint_T' + + CHARACTER(1024) :: FileName ! Name of the (input) checkpoint file + CHARACTER(1024) :: DLLFileName ! Name of the (input) checkpoint file + + + ErrStat=ErrID_None + ErrMsg="" + + FileName = TRIM(CheckpointRoot)//'.chkp' + DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' + ! FileName = TRIM(CheckpointRoot)//'.cp' + unIn=-1 + IF (PRESENT(Unit)) unIn = Unit + + IF ( unIn < 0 ) THEN + + CALL GetNewUnit( unIn, ErrStat2, ErrMsg2 ) + + CALL OpenBInpFile(unIn, FileName, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev ) return + + 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 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) return + + ! Read the packed arrays + 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 + 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 + CLOSE(unIn) + unIn = -1 + END IF + + IF (PRESENT(Unit)) Unit = unIn + + ! 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) + 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 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! A hack to restore Bladed-style DLL data + if (Turbine%SrvD%p%UseBladedInterface) then + if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) + FileName = Turbine%SrvD%m%dll_data%DLL_InFile + ! overwrite values before calling DLL: + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_RESTARTING + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! put values back: + Turbine%SrvD%m%dll_data%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + end if + end if + + ! deal with sibling meshes here: + ! (ignoring for now; they are not going to be siblings on restart) + + Turbine%HD%p%PointsToSeaState = .false. ! since the pointers aren't pointing to the same data as SeaState after restart, set this to avoid memory leaks and deallocation problems + + ! deal with files that were open: + IF (Turbine%p_FAST%WrTxtOutFile) THEN + CALL OpenFunkFileAppend ( Turbine%y_FAST%UnOu, TRIM(Turbine%p_FAST%OutFileRoot)//'.out', ErrStat2, ErrMsg2) + IF ( ErrStat2 >= AbortErrLev ) RETURN + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + 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]) + +END SUBROUTINE FAST_RestoreFromCheckpoint_T +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_RestoreForVTKModeShape_T for an array of Turbine data structures. +SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time (for comparing with time from checkpoint file) + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine(:) !< all data for one instance of a turbine !intent(INOUT) instead of (IN) to attempt to avoid memory warnings in gnu compilers + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i_turb + INTEGER(IntKi) :: n_t_global !< loop counter + INTEGER(IntKi) :: NumTurbines ! Number of turbines in this simulation + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_Tary' + + + ErrStat = ErrID_None + ErrMsg = "" + + NumTurbines = SIZE(Turbine) + if (NumTurbines /=1) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization is not available for multiple turbines.", ErrStat, ErrMsg, RoutineName) + return + end if + + + CALL ReadModeShapeFile( Turbine(1)%p_FAST, trim(InputFileName), ErrStat2, ErrMsg2, checkpointOnly=.true. ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + CALL FAST_RestoreFromCheckpoint_Tary( t_initial, n_t_global, Turbine, trim(Turbine(1)%p_FAST%VTK_modes%CheckpointRoot), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + DO i_turb = 1,NumTurbines + if (.not. allocated(Turbine(i_turb)%m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization requires a checkpoint file from a simulation with linearization analysis, but NLinTimes is 0.", ErrStat, ErrMsg, RoutineName) + return + end if + + CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & + Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%OpFM, & + Turbine(i_turb)%SeaSt, Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + +END SUBROUTINE FAST_RestoreForVTKModeShape_Tary + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calculates the motions generated by mode shapes and outputs VTK data for it +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: dt ! time + REAL(DbKi) :: tprime ! time + INTEGER(IntKi) :: nt + + INTEGER(IntKi) :: iLinTime ! generic loop counters + INTEGER(IntKi) :: it ! generic loop counters + INTEGER(IntKi) :: iMode ! loop counter on modes + INTEGER(IntKi) :: iModeMax ! maximum mode number (based on what is present in the binary file) + INTEGER(IntKi) :: ModeNo ! mode number + INTEGER(IntKi) :: NLinTimes + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_T' + CHARACTER(1024) :: VTK_RootName + CHARACTER(1024) :: VTK_RootDir + CHARACTER(1024) :: vtkroot + CHARACTER(1024) :: sInfo !< String used for formatted screen output + + + ErrStat = ErrID_None + ErrMsg = "" + + CALL ReadModeShapeFile( p_FAST, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + call ReadModeShapeMatlabFile( p_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) return + + y_FAST%WriteThisStep = .true. + y_FAST%UnSum = -1 + + NLinTimes = min( p_FAST%VTK_modes%VTKNLinTimes, size(p_FAST%VTK_modes%x_eig_magnitude,2), p_FAST%NLinTimes ) + + VTK_RootName = p_FAST%VTK_OutFileRoot + + ! Creating VTK folder in case user deleted it. + ! We have to extract the vtk root dir again because p_FAST%VTK_OutFileRoot contains the full basename + call GetPath ( p_FAST%OutFileRoot, VTK_RootDir, vtkroot ) + VTK_RootDir = trim(VTK_RootDir) // 'vtk' + call MKDIR( trim(VTK_RootDir) ) + + + iModeMax = size(p_FAST%VTK_Modes%x_eig_magnitude, 3) + + do iMode = 1,p_FAST%VTK_modes%VTKLinModes + ModeNo = p_FAST%VTK_modes%VTKModes(iMode) + if (ModeNo>iModeMax) then + call WrScr(' Skipping mode '//trim(num2lstr(ModeNo))//', maximum number of modes reached ('//trim(num2lstr(iModeMax))//'). Exiting.') + exit; + endif + call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, p_FAST%VTK_modes%VTKLinTim, nt, dt, p_FAST%VTK_tWidth ) + write(sInfo, '(A,I4,A,F12.4,A,I4,A,I0)') 'Mode',ModeNo,', Freq=', p_FAST%VTK_modes%DampedFreq_Hz(ModeNo),'Hz, NLinTimes=',NLinTimes,', nt=',nt + call WrScr(trim(sInfo)) + if (nt > 500) then + call WrScr(' Skipping mode '//trim(num2lstr(ModeNo))//' due to low frequency.') + cycle + endif + + select case (p_FAST%VTK_modes%VTKLinTim) + case (1) + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + do iLinTime = 1,NLinTimes + tprime = m_FAST%Lin%LinTimes(iLinTime) - m_FAST%Lin%LinTimes(1) + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do ! iLinTime + case (2) + + do iLinTime = 1,NLinTimes + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo))//'.LinTime'//trim(num2lstr(iLinTime)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + do it = 1,nt + tprime = (it-1)*dt + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do ! it + end do ! iLinTime + + end select ! VTKLinTim=1 or 2 + + end do ! iMode + + + + +END SUBROUTINE FAST_RestoreForVTKModeShape_T +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, VTKLinTim, nt, dt, VTK_tWidth) + REAL(R8Ki), INTENT(IN ) :: DampedFreq_Hz + REAL(DbKi), INTENT(IN ) :: VTK_fps + INTEGER(IntKi), INTENT(IN ) :: VTKLinTim + INTEGER(IntKi), INTENT( OUT) :: nt !< number of steps + REAL(DbKi), INTENT( OUT) :: dt !< time step + INTEGER(IntKi), INTENT( OUT) :: VTK_tWidth + + REAL(DbKi) :: cycle_time ! time for one cycle of mode + INTEGER(IntKi) :: NCycles + INTEGER(IntKi), PARAMETER :: MinFrames = 5 + + if (DampedFreq_Hz <= 1e-4_DbKi) then + nt = huge(nt) + dt = epsilon(dt) + VTK_tWidth = 1 + return + end if + + if (VTKLinTim==1) then + nt = 1 + NCycles = 0 + do while (nt= AbortErrLev) RETURN + + ! Process the requested data records of this file. + + CALL WrScr ( NewLine//' =======================================================' ) + CALL WrScr ( ' Reading binary mode file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".') + + + ! Read some of the header information. + + READ (UnIn, IOSTAT=ErrStat2) FileType ! placeholder for future file format changes + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading FileType from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nModes ! number of modes in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nModes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nStates ! number of states in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nStates from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) NLinTimes ! number of linearization times / azimuths in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NLinTimes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + CALL WrScr ( ' Number of modes: '//TRIM(num2lstr(nModes))//', states: '//TRIM(num2lstr(nStates))//', linTimes: '//TRIM(num2lstr(NLinTimes))//'.') + + ALLOCATE( p_FAST%VTK_Modes%NaturalFreq_Hz(nModes), & + p_FAST%VTK_Modes%DampingRatio( nModes), & + p_FAST%VTK_Modes%DampedFreq_Hz( nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%NaturalFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NaturalFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampingRatio ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampingRatio array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampedFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampedFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + if (NLinTimes /= p_FAST%NLinTimes) CALL SetErrStat(ErrID_Severe,'Number of times linearization was performed is not the same as the number of linearization times in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + + ! Maximum mode index requested by user + iModeMax = maxval(p_FAST%VTK_modes%VTKModes(:)) + if (nModes < iModeMax) then + call WrScr(' Warning: the maximum index in VTKModes ('//trim(num2lstr(iModeMax))//') exceeds the number of modes ('//trim(num2lstr(nModes))//') from binary file.'); + endif + ! Let's read only the number of modes we need to use + nModes = min( nModes, iModeMax) + + ALLOCATE( p_FAST%VTK_Modes%x_eig_magnitude(nStates, NLinTimes, nModes), & + p_FAST%VTK_Modes%x_eig_phase( nStates, NLinTimes, nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + do iMode = 1,nModes + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_magnitude(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_magnitude from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_phase(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_phase from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + end do + +END SUBROUTINE ReadModeShapeMatlabFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + CHARACTER(*), INTENT(IN ) :: InputFile !< Name of the text input file to read + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: checkpointOnly !< Whether to return after reading checkpoint file name + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ReadModeShapeFile' + + CHARACTER(1024) :: PriPath ! Path name of the primary file + INTEGER(IntKi) :: i + INTEGER(IntKi) :: UnIn + INTEGER(IntKi) :: UnEc + LOGICAL :: VTKLinTimes1 + + ErrStat = ErrID_None + ErrMsg = "" + UnEc = -1 + + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + ! Open data file. + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) + + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + + CALL ReadCom( UnIn, InputFile, 'File header: (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadCom( UnIn, InputFile, 'File header: (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !----------- FILE NAMES ---------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: File Names', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%CheckpointRoot, 'CheckpointRoot', 'Name of the checkpoint file written by FAST when linearization data was produced', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF ( PathIsRelative( p_FAST%VTK_modes%CheckpointRoot ) ) p_FAST%VTK_modes%CheckpointRoot = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%CheckpointRoot) + + if (present(checkpointOnly)) then + if (checkpointOnly) then + call cleanup() + return + end if + end if + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%MatlabFileName, 'MatlabFileName', 'Name of the file with eigenvectors written by Matlab', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + IF ( PathIsRelative( p_FAST%VTK_modes%MatlabFileName ) ) p_FAST%VTK_modes%MatlabFileName = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%MatlabFileName) + + !----------- VISUALIZATION OPTIONS ------------------------------------------ + + CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization Options', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinModes, 'VTKLinModes', 'Number of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + if (p_FAST%VTK_modes%VTKLinModes <= 0) CALL SetErrStat( ErrID_Fatal, "VTKLinModes must be a positive number.", ErrStat, ErrMsg, RoutineName ) + + if (ErrStat >= AbortErrLev) then + CALL Cleanup() + RETURN + end if + + + call AllocAry( p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + + p_FAST%VTK_modes%VTKModes = -1 + + CALL ReadAry( UnIn, InputFile, p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', 'List of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + ! note that we don't check the ErrStat here; if the user entered fewer than p_FAST%VTK_modes%VTKLinModes values, we will use the + ! last entry to fill in remaining values. + !Check 1st value, we need at least one good value from user or throw error + IF (p_FAST%VTK_modes%VTKModes(1) < 0 ) THEN + call SetErrStat( ErrID_Fatal, "VTKModes must contain positive numbers.", ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + ELSE + DO i = 2, p_FAST%VTK_modes%VTKLinModes + IF ( p_FAST%VTK_modes%VTKModes(i) < 0 ) THEN + p_FAST%VTK_modes%VTKModes(i)=p_FAST%VTK_modes%VTKModes(i-1) + 1 + ENDIF + ENDDO + ENDIF + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinScale, 'VTKLinScale', 'Mode shape visualization scaling factor', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinTim, 'VTKLinTim', 'Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, VTKLinTimes1, 'VTKLinTimes1', 'If VTKLinTim=2, visualize modes at LinTimes(1) only?', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinPhase, 'VTKLinPhase', 'Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +! overwrite these based on inputs: + + if (p_FAST%VTK_modes%VTKLinTim == 2) then + !p_FAST%VTK_modes%VTKLinPhase = 0 ! "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - + + if (VTKLinTimes1) then + p_FAST%VTK_modes%VTKNLinTimes = 1 + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + +contains + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE(UnIn) + END SUBROUTINE Cleanup + +END SUBROUTINE ReadModeShapeFile +!---------------------------------------------------------------------------------------------------------------------------------- +END MODULE FAST_Subs +!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index aa9ff1b0c6..4510c58295 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -109,6 +109,68 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_phase !< phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] END TYPE FAST_VTK_ModeShapeType ! ======================= +! ========= TC_ParameterType ======= + TYPE, PUBLIC :: TC_ParameterType + REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] + REAL(R8Ki) :: ConvTol = 0.0_R8Ki !< Solution convergence tolerance [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< [-] + INTEGER(IntKi) :: MaxConvIter = 0_IntKi !< [-] + INTEGER(IntKi) :: NIter_UJac = 0_IntKi !< Number of solution iterations between updating the Jacobian [-] + INTEGER(IntKi) :: NStep_UJac = 0_IntKi !< Number of global time steps between updating the Jacobian [-] + REAL(R8Ki) :: Scale_UJac = 0.0_R8Ki !< [-] + REAL(R8Ki) :: AccBlend = 1 !< [-] + REAL(R8Ki) :: RhoInf = 0.0_R8Ki !< Rho infinity used for calculating Generalized-alpha coefficients [-] + REAL(R8Ki) :: AlphaM = 0.0_R8Ki !< Generalized-alpha alpha_m coefficient [-] + REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] + REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] + REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] + REAL(R8Ki) , DIMENSION(1:3) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iX1Tight !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iX2Tight !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUTight !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUOpt1 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyTight !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyOpt1 !< [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJX2 !< Indices of Jacobian q variables [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJT !< Indices of Jacobian tight coupling variables [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJ1 !< Indices of Jacobian option 1 variables [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModAll !< ModData index order for all modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] + END TYPE TC_ParameterType +! ======================= +! ========= TC_MiscVarType ======= + TYPE, PUBLIC :: TC_MiscVarType + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: q !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: qn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: un !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_tmp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] + INTEGER(IntKi) :: IterTotal = 0 !< [-] + INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] + INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dq !< Change in q [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] + END TYPE TC_MiscVarType +! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] @@ -205,6 +267,7 @@ MODULE FAST_Types 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 [-] + TYPE(TC_ParameterType) :: Solver !< Tight Coupling Solver Parameters [-] END TYPE FAST_ParameterType ! ======================= ! ========= FAST_LinStateSave ======= @@ -382,6 +445,7 @@ MODULE FAST_Types ! ========= BeamDyn_Data ======= TYPE, PUBLIC :: BeamDyn_Data TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(BD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: dxdt !< Continuous state derivatives [-] TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd !< Discrete states [-] TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z !< Constraint states [-] TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt !< Other states [-] @@ -398,6 +462,7 @@ MODULE FAST_Types ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data TYPE(ED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(ED_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] TYPE(ED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] TYPE(ED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] TYPE(ED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] @@ -491,6 +556,7 @@ MODULE FAST_Types ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data TYPE(SD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(SD_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] TYPE(SD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] TYPE(SD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] TYPE(SD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] @@ -715,6 +781,8 @@ MODULE FAST_Types 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 [-] + TYPE(ModDataType) , DIMENSION(:), ALLOCATABLE :: Modules !< module variable and value data [-] + TYPE(TC_MiscVarType) :: Solver !< Tight coupling solver Miscellaneous variables [-] END TYPE FAST_MiscVarType ! ======================= ! ========= FAST_InitData ======= @@ -1282,128 +1350,1534 @@ subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz), ubound(InData%NaturalFreq_Hz)) call RegPack(Buf, InData%NaturalFreq_Hz) end if - call RegPack(Buf, allocated(InData%DampedFreq_Hz)) - if (allocated(InData%DampedFreq_Hz)) then - call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz), ubound(InData%DampedFreq_Hz)) - call RegPack(Buf, InData%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 + 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 + 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 + call RegUnpack(Buf, OutData%CheckpointRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MatlabFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKLinModes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTKModes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VTKModes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%VTKLinTim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKNLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKLinScale) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKLinPhase) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampingRatio(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampingRatio) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NaturalFreq_Hz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NaturalFreq_Hz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampedFreq_Hz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampedFreq_Hz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_eig_magnitude) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_eig_phase) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_ParameterType), intent(in) :: SrcTC_ParameterTypeData + type(TC_ParameterType), intent(inout) :: DstTC_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 = 'FAST_CopyTC_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstTC_ParameterTypeData%DT = SrcTC_ParameterTypeData%DT + DstTC_ParameterTypeData%ConvTol = SrcTC_ParameterTypeData%ConvTol + DstTC_ParameterTypeData%NumCrctn = SrcTC_ParameterTypeData%NumCrctn + DstTC_ParameterTypeData%MaxConvIter = SrcTC_ParameterTypeData%MaxConvIter + DstTC_ParameterTypeData%NIter_UJac = SrcTC_ParameterTypeData%NIter_UJac + DstTC_ParameterTypeData%NStep_UJac = SrcTC_ParameterTypeData%NStep_UJac + DstTC_ParameterTypeData%Scale_UJac = SrcTC_ParameterTypeData%Scale_UJac + DstTC_ParameterTypeData%AccBlend = SrcTC_ParameterTypeData%AccBlend + DstTC_ParameterTypeData%RhoInf = SrcTC_ParameterTypeData%RhoInf + DstTC_ParameterTypeData%AlphaM = SrcTC_ParameterTypeData%AlphaM + DstTC_ParameterTypeData%AlphaF = SrcTC_ParameterTypeData%AlphaF + DstTC_ParameterTypeData%Beta = SrcTC_ParameterTypeData%Beta + DstTC_ParameterTypeData%Gamma = SrcTC_ParameterTypeData%Gamma + DstTC_ParameterTypeData%C = SrcTC_ParameterTypeData%C + if (allocated(SrcTC_ParameterTypeData%iX1Tight)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iX1Tight) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iX1Tight) + if (.not. allocated(DstTC_ParameterTypeData%iX1Tight)) then + allocate(DstTC_ParameterTypeData%iX1Tight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iX1Tight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iX1Tight = SrcTC_ParameterTypeData%iX1Tight + end if + if (allocated(SrcTC_ParameterTypeData%iX2Tight)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iX2Tight) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iX2Tight) + if (.not. allocated(DstTC_ParameterTypeData%iX2Tight)) then + allocate(DstTC_ParameterTypeData%iX2Tight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iX2Tight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iX2Tight = SrcTC_ParameterTypeData%iX2Tight + end if + if (allocated(SrcTC_ParameterTypeData%iUTight)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iUTight) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iUTight) + if (.not. allocated(DstTC_ParameterTypeData%iUTight)) then + allocate(DstTC_ParameterTypeData%iUTight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iUTight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iUTight = SrcTC_ParameterTypeData%iUTight + end if + if (allocated(SrcTC_ParameterTypeData%iUOpt1)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iUOpt1) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iUOpt1) + if (.not. allocated(DstTC_ParameterTypeData%iUOpt1)) then + allocate(DstTC_ParameterTypeData%iUOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iUOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iUOpt1 = SrcTC_ParameterTypeData%iUOpt1 + end if + if (allocated(SrcTC_ParameterTypeData%iyTight)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iyTight) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iyTight) + if (.not. allocated(DstTC_ParameterTypeData%iyTight)) then + allocate(DstTC_ParameterTypeData%iyTight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iyTight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iyTight = SrcTC_ParameterTypeData%iyTight + end if + if (allocated(SrcTC_ParameterTypeData%iyOpt1)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iyOpt1) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iyOpt1) + if (.not. allocated(DstTC_ParameterTypeData%iyOpt1)) then + allocate(DstTC_ParameterTypeData%iyOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iyOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iyOpt1 = SrcTC_ParameterTypeData%iyOpt1 + end if + if (allocated(SrcTC_ParameterTypeData%ixqd)) then + LB(1:2) = lbound(SrcTC_ParameterTypeData%ixqd) + UB(1:2) = ubound(SrcTC_ParameterTypeData%ixqd) + if (.not. allocated(DstTC_ParameterTypeData%ixqd)) then + allocate(DstTC_ParameterTypeData%ixqd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%ixqd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%ixqd = SrcTC_ParameterTypeData%ixqd + end if + if (allocated(SrcTC_ParameterTypeData%iJX2)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iJX2) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iJX2) + if (.not. allocated(DstTC_ParameterTypeData%iJX2)) then + allocate(DstTC_ParameterTypeData%iJX2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJX2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iJX2 = SrcTC_ParameterTypeData%iJX2 + end if + if (allocated(SrcTC_ParameterTypeData%iJT)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iJT) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iJT) + if (.not. allocated(DstTC_ParameterTypeData%iJT)) then + allocate(DstTC_ParameterTypeData%iJT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iJT = SrcTC_ParameterTypeData%iJT + end if + if (allocated(SrcTC_ParameterTypeData%iJ1)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iJ1) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iJ1) + if (.not. allocated(DstTC_ParameterTypeData%iJ1)) then + allocate(DstTC_ParameterTypeData%iJ1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJ1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iJ1 = SrcTC_ParameterTypeData%iJ1 + end if + if (allocated(SrcTC_ParameterTypeData%iJL)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iJL) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iJL) + if (.not. allocated(DstTC_ParameterTypeData%iJL)) then + allocate(DstTC_ParameterTypeData%iJL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iJL = SrcTC_ParameterTypeData%iJL + end if + if (allocated(SrcTC_ParameterTypeData%iModAll)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModAll) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModAll) + if (.not. allocated(DstTC_ParameterTypeData%iModAll)) then + allocate(DstTC_ParameterTypeData%iModAll(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModAll = SrcTC_ParameterTypeData%iModAll + end if + if (allocated(SrcTC_ParameterTypeData%iModTC)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModTC) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModTC) + if (.not. allocated(DstTC_ParameterTypeData%iModTC)) then + allocate(DstTC_ParameterTypeData%iModTC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModTC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModTC = SrcTC_ParameterTypeData%iModTC + end if + if (allocated(SrcTC_ParameterTypeData%iModOpt1)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1) + if (.not. allocated(DstTC_ParameterTypeData%iModOpt1)) then + allocate(DstTC_ParameterTypeData%iModOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModOpt1 = SrcTC_ParameterTypeData%iModOpt1 + end if + if (allocated(SrcTC_ParameterTypeData%iModOpt1US)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1US) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1US) + if (.not. allocated(DstTC_ParameterTypeData%iModOpt1US)) then + allocate(DstTC_ParameterTypeData%iModOpt1US(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt1US.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModOpt1US = SrcTC_ParameterTypeData%iModOpt1US + end if + if (allocated(SrcTC_ParameterTypeData%iModOpt2)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt2) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt2) + if (.not. allocated(DstTC_ParameterTypeData%iModOpt2)) then + allocate(DstTC_ParameterTypeData%iModOpt2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModOpt2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModOpt2 = SrcTC_ParameterTypeData%iModOpt2 + end if +end subroutine + +subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) + type(TC_ParameterType), intent(inout) :: TC_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyTC_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_ParameterTypeData%iX1Tight)) then + deallocate(TC_ParameterTypeData%iX1Tight) + end if + if (allocated(TC_ParameterTypeData%iX2Tight)) then + deallocate(TC_ParameterTypeData%iX2Tight) + end if + if (allocated(TC_ParameterTypeData%iUTight)) then + deallocate(TC_ParameterTypeData%iUTight) + end if + if (allocated(TC_ParameterTypeData%iUOpt1)) then + deallocate(TC_ParameterTypeData%iUOpt1) + end if + if (allocated(TC_ParameterTypeData%iyTight)) then + deallocate(TC_ParameterTypeData%iyTight) + end if + if (allocated(TC_ParameterTypeData%iyOpt1)) then + deallocate(TC_ParameterTypeData%iyOpt1) + end if + if (allocated(TC_ParameterTypeData%ixqd)) then + deallocate(TC_ParameterTypeData%ixqd) + end if + if (allocated(TC_ParameterTypeData%iJX2)) then + deallocate(TC_ParameterTypeData%iJX2) + end if + if (allocated(TC_ParameterTypeData%iJT)) then + deallocate(TC_ParameterTypeData%iJT) + end if + if (allocated(TC_ParameterTypeData%iJ1)) then + deallocate(TC_ParameterTypeData%iJ1) + end if + if (allocated(TC_ParameterTypeData%iJL)) then + deallocate(TC_ParameterTypeData%iJL) + end if + if (allocated(TC_ParameterTypeData%iModAll)) then + deallocate(TC_ParameterTypeData%iModAll) + end if + if (allocated(TC_ParameterTypeData%iModTC)) then + deallocate(TC_ParameterTypeData%iModTC) + end if + if (allocated(TC_ParameterTypeData%iModOpt1)) then + deallocate(TC_ParameterTypeData%iModOpt1) + end if + if (allocated(TC_ParameterTypeData%iModOpt1US)) then + deallocate(TC_ParameterTypeData%iModOpt1US) + end if + if (allocated(TC_ParameterTypeData%iModOpt2)) then + deallocate(TC_ParameterTypeData%iModOpt2) + end if +end subroutine + +subroutine FAST_PackTC_ParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_ParameterType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%ConvTol) + call RegPack(Buf, InData%NumCrctn) + call RegPack(Buf, InData%MaxConvIter) + call RegPack(Buf, InData%NIter_UJac) + call RegPack(Buf, InData%NStep_UJac) + call RegPack(Buf, InData%Scale_UJac) + call RegPack(Buf, InData%AccBlend) + call RegPack(Buf, InData%RhoInf) + call RegPack(Buf, InData%AlphaM) + call RegPack(Buf, InData%AlphaF) + call RegPack(Buf, InData%Beta) + call RegPack(Buf, InData%Gamma) + call RegPack(Buf, InData%C) + call RegPack(Buf, allocated(InData%iX1Tight)) + if (allocated(InData%iX1Tight)) then + call RegPackBounds(Buf, 1, lbound(InData%iX1Tight), ubound(InData%iX1Tight)) + call RegPack(Buf, InData%iX1Tight) + end if + call RegPack(Buf, allocated(InData%iX2Tight)) + if (allocated(InData%iX2Tight)) then + call RegPackBounds(Buf, 1, lbound(InData%iX2Tight), ubound(InData%iX2Tight)) + call RegPack(Buf, InData%iX2Tight) + end if + call RegPack(Buf, allocated(InData%iUTight)) + if (allocated(InData%iUTight)) then + call RegPackBounds(Buf, 1, lbound(InData%iUTight), ubound(InData%iUTight)) + call RegPack(Buf, InData%iUTight) + end if + call RegPack(Buf, allocated(InData%iUOpt1)) + if (allocated(InData%iUOpt1)) then + call RegPackBounds(Buf, 1, lbound(InData%iUOpt1), ubound(InData%iUOpt1)) + call RegPack(Buf, InData%iUOpt1) + end if + call RegPack(Buf, allocated(InData%iyTight)) + if (allocated(InData%iyTight)) then + call RegPackBounds(Buf, 1, lbound(InData%iyTight), ubound(InData%iyTight)) + call RegPack(Buf, InData%iyTight) + end if + call RegPack(Buf, allocated(InData%iyOpt1)) + if (allocated(InData%iyOpt1)) then + call RegPackBounds(Buf, 1, lbound(InData%iyOpt1), ubound(InData%iyOpt1)) + call RegPack(Buf, InData%iyOpt1) + end if + call RegPack(Buf, allocated(InData%ixqd)) + if (allocated(InData%ixqd)) then + call RegPackBounds(Buf, 2, lbound(InData%ixqd), ubound(InData%ixqd)) + call RegPack(Buf, InData%ixqd) + end if + call RegPack(Buf, allocated(InData%iJX2)) + if (allocated(InData%iJX2)) then + call RegPackBounds(Buf, 1, lbound(InData%iJX2), ubound(InData%iJX2)) + call RegPack(Buf, InData%iJX2) + end if + call RegPack(Buf, allocated(InData%iJT)) + if (allocated(InData%iJT)) then + call RegPackBounds(Buf, 1, lbound(InData%iJT), ubound(InData%iJT)) + call RegPack(Buf, InData%iJT) + end if + call RegPack(Buf, allocated(InData%iJ1)) + if (allocated(InData%iJ1)) then + call RegPackBounds(Buf, 1, lbound(InData%iJ1), ubound(InData%iJ1)) + call RegPack(Buf, InData%iJ1) + end if + call RegPack(Buf, allocated(InData%iJL)) + if (allocated(InData%iJL)) then + call RegPackBounds(Buf, 1, lbound(InData%iJL), ubound(InData%iJL)) + call RegPack(Buf, InData%iJL) + end if + call RegPack(Buf, allocated(InData%iModAll)) + if (allocated(InData%iModAll)) then + call RegPackBounds(Buf, 1, lbound(InData%iModAll), ubound(InData%iModAll)) + call RegPack(Buf, InData%iModAll) + end if + call RegPack(Buf, allocated(InData%iModTC)) + if (allocated(InData%iModTC)) then + call RegPackBounds(Buf, 1, lbound(InData%iModTC), ubound(InData%iModTC)) + call RegPack(Buf, InData%iModTC) + end if + call RegPack(Buf, allocated(InData%iModOpt1)) + if (allocated(InData%iModOpt1)) then + call RegPackBounds(Buf, 1, lbound(InData%iModOpt1), ubound(InData%iModOpt1)) + call RegPack(Buf, InData%iModOpt1) + end if + call RegPack(Buf, allocated(InData%iModOpt1US)) + if (allocated(InData%iModOpt1US)) then + call RegPackBounds(Buf, 1, lbound(InData%iModOpt1US), ubound(InData%iModOpt1US)) + call RegPack(Buf, InData%iModOpt1US) + end if + call RegPack(Buf, allocated(InData%iModOpt2)) + if (allocated(InData%iModOpt2)) then + call RegPackBounds(Buf, 1, lbound(InData%iModOpt2), ubound(InData%iModOpt2)) + call RegPack(Buf, InData%iModOpt2) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTC_ParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_ParameterType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConvTol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCrctn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MaxConvIter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NIter_UJac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStep_UJac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Scale_UJac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AccBlend) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RhoInf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AlphaM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AlphaF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Beta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gamma) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%iX1Tight)) deallocate(OutData%iX1Tight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iX1Tight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iX1Tight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iX1Tight) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iX2Tight)) deallocate(OutData%iX2Tight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iX2Tight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iX2Tight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iX2Tight) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iUTight)) deallocate(OutData%iUTight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iUTight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iUTight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iUTight) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iUOpt1)) deallocate(OutData%iUOpt1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iUOpt1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iUOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iUOpt1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iyTight)) deallocate(OutData%iyTight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iyTight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyTight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iyTight) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iyOpt1)) deallocate(OutData%iyOpt1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iyOpt1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iyOpt1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ixqd)) deallocate(OutData%ixqd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ixqd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ixqd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ixqd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iJX2)) deallocate(OutData%iJX2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iJX2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJX2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iJX2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iJT)) deallocate(OutData%iJT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iJT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iJT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iJ1)) deallocate(OutData%iJ1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iJ1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJ1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iJ1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iJL)) deallocate(OutData%iJL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iJL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iJL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iModAll)) deallocate(OutData%iModAll) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iModAll(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModAll) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iModTC)) deallocate(OutData%iModTC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iModTC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModTC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModTC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iModOpt1)) deallocate(OutData%iModOpt1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iModOpt1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModOpt1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iModOpt1US)) deallocate(OutData%iModOpt1US) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iModOpt1US(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModOpt1US.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModOpt1US) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iModOpt2)) deallocate(OutData%iModOpt2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iModOpt2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModOpt2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModOpt2) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_MiscVarType), intent(in) :: SrcTC_MiscVarTypeData + type(TC_MiscVarType), intent(inout) :: DstTC_MiscVarTypeData + 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_CopyTC_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTC_MiscVarTypeData%q)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%q) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%q) + if (.not. allocated(DstTC_MiscVarTypeData%q)) then + allocate(DstTC_MiscVarTypeData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%q = SrcTC_MiscVarTypeData%q + end if + if (allocated(SrcTC_MiscVarTypeData%qn)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%qn) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%qn) + if (.not. allocated(DstTC_MiscVarTypeData%qn)) then + allocate(DstTC_MiscVarTypeData%qn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%qn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%qn = SrcTC_MiscVarTypeData%qn + end if + if (allocated(SrcTC_MiscVarTypeData%x)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%x) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%x) + if (.not. allocated(DstTC_MiscVarTypeData%x)) then + allocate(DstTC_MiscVarTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%x = SrcTC_MiscVarTypeData%x + end if + if (allocated(SrcTC_MiscVarTypeData%xn)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%xn) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%xn) + if (.not. allocated(DstTC_MiscVarTypeData%xn)) then + allocate(DstTC_MiscVarTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%xn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%xn = SrcTC_MiscVarTypeData%xn + end if + if (allocated(SrcTC_MiscVarTypeData%dxdt)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%dxdt) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%dxdt) + if (.not. allocated(DstTC_MiscVarTypeData%dxdt)) then + allocate(DstTC_MiscVarTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dxdt = SrcTC_MiscVarTypeData%dxdt + end if + if (allocated(SrcTC_MiscVarTypeData%u)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%u) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%u) + if (.not. allocated(DstTC_MiscVarTypeData%u)) then + allocate(DstTC_MiscVarTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%u = SrcTC_MiscVarTypeData%u + end if + if (allocated(SrcTC_MiscVarTypeData%un)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%un) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%un) + if (.not. allocated(DstTC_MiscVarTypeData%un)) then + allocate(DstTC_MiscVarTypeData%un(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%un.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%un = SrcTC_MiscVarTypeData%un + end if + if (allocated(SrcTC_MiscVarTypeData%u_tmp)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%u_tmp) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%u_tmp) + if (.not. allocated(DstTC_MiscVarTypeData%u_tmp)) then + allocate(DstTC_MiscVarTypeData%u_tmp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%u_tmp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%u_tmp = SrcTC_MiscVarTypeData%u_tmp + end if + if (allocated(SrcTC_MiscVarTypeData%y)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%y) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%y) + if (.not. allocated(DstTC_MiscVarTypeData%y)) then + allocate(DstTC_MiscVarTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%y = SrcTC_MiscVarTypeData%y + end if + if (allocated(SrcTC_MiscVarTypeData%dYdx)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dYdx) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dYdx) + if (.not. allocated(DstTC_MiscVarTypeData%dYdx)) then + allocate(DstTC_MiscVarTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dYdx = SrcTC_MiscVarTypeData%dYdx + end if + if (allocated(SrcTC_MiscVarTypeData%dYdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dYdu) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dYdu) + if (.not. allocated(DstTC_MiscVarTypeData%dYdu)) then + allocate(DstTC_MiscVarTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dYdu = SrcTC_MiscVarTypeData%dYdu + end if + if (allocated(SrcTC_MiscVarTypeData%dXdx)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dXdx) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dXdx) + if (.not. allocated(DstTC_MiscVarTypeData%dXdx)) then + allocate(DstTC_MiscVarTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dXdx = SrcTC_MiscVarTypeData%dXdx + end if + if (allocated(SrcTC_MiscVarTypeData%dXdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dXdu) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dXdu) + if (.not. allocated(DstTC_MiscVarTypeData%dXdu)) then + allocate(DstTC_MiscVarTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dXdu = SrcTC_MiscVarTypeData%dXdu + end if + if (allocated(SrcTC_MiscVarTypeData%dUdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdu) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdu) + if (.not. allocated(DstTC_MiscVarTypeData%dUdu)) then + allocate(DstTC_MiscVarTypeData%dUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dUdu = SrcTC_MiscVarTypeData%dUdu + end if + if (allocated(SrcTC_MiscVarTypeData%dUdy)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdy) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdy) + if (.not. allocated(DstTC_MiscVarTypeData%dUdy)) then + allocate(DstTC_MiscVarTypeData%dUdy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dUdy = SrcTC_MiscVarTypeData%dUdy + end if + if (allocated(SrcTC_MiscVarTypeData%XB)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%XB) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%XB) + if (.not. allocated(DstTC_MiscVarTypeData%XB)) then + allocate(DstTC_MiscVarTypeData%XB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%XB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%XB = SrcTC_MiscVarTypeData%XB + end if + if (allocated(SrcTC_MiscVarTypeData%Jac)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%Jac) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%Jac) + if (.not. allocated(DstTC_MiscVarTypeData%Jac)) then + allocate(DstTC_MiscVarTypeData%Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%Jac = SrcTC_MiscVarTypeData%Jac + end if + if (allocated(SrcTC_MiscVarTypeData%IPIV)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%IPIV) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%IPIV) + if (.not. allocated(DstTC_MiscVarTypeData%IPIV)) then + allocate(DstTC_MiscVarTypeData%IPIV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%IPIV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%IPIV = SrcTC_MiscVarTypeData%IPIV + end if + DstTC_MiscVarTypeData%IterTotal = SrcTC_MiscVarTypeData%IterTotal + DstTC_MiscVarTypeData%IterUntilUJac = SrcTC_MiscVarTypeData%IterUntilUJac + DstTC_MiscVarTypeData%StepsUntilUJac = SrcTC_MiscVarTypeData%StepsUntilUJac + if (allocated(SrcTC_MiscVarTypeData%dq)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dq) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dq) + if (.not. allocated(DstTC_MiscVarTypeData%dq)) then + allocate(DstTC_MiscVarTypeData%dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dq = SrcTC_MiscVarTypeData%dq + end if + if (allocated(SrcTC_MiscVarTypeData%dx)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%dx) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%dx) + if (.not. allocated(DstTC_MiscVarTypeData%dx)) then + allocate(DstTC_MiscVarTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dx = SrcTC_MiscVarTypeData%dx + end if + if (allocated(SrcTC_MiscVarTypeData%du)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%du) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%du) + if (.not. allocated(DstTC_MiscVarTypeData%du)) then + allocate(DstTC_MiscVarTypeData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%du = SrcTC_MiscVarTypeData%du + end if +end subroutine + +subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) + type(TC_MiscVarType), intent(inout) :: TC_MiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyTC_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_MiscVarTypeData%q)) then + deallocate(TC_MiscVarTypeData%q) + end if + if (allocated(TC_MiscVarTypeData%qn)) then + deallocate(TC_MiscVarTypeData%qn) + end if + if (allocated(TC_MiscVarTypeData%x)) then + deallocate(TC_MiscVarTypeData%x) + end if + if (allocated(TC_MiscVarTypeData%xn)) then + deallocate(TC_MiscVarTypeData%xn) + end if + if (allocated(TC_MiscVarTypeData%dxdt)) then + deallocate(TC_MiscVarTypeData%dxdt) + end if + if (allocated(TC_MiscVarTypeData%u)) then + deallocate(TC_MiscVarTypeData%u) + end if + if (allocated(TC_MiscVarTypeData%un)) then + deallocate(TC_MiscVarTypeData%un) + end if + if (allocated(TC_MiscVarTypeData%u_tmp)) then + deallocate(TC_MiscVarTypeData%u_tmp) + end if + if (allocated(TC_MiscVarTypeData%y)) then + deallocate(TC_MiscVarTypeData%y) + end if + if (allocated(TC_MiscVarTypeData%dYdx)) then + deallocate(TC_MiscVarTypeData%dYdx) + end if + if (allocated(TC_MiscVarTypeData%dYdu)) then + deallocate(TC_MiscVarTypeData%dYdu) + end if + if (allocated(TC_MiscVarTypeData%dXdx)) then + deallocate(TC_MiscVarTypeData%dXdx) + end if + if (allocated(TC_MiscVarTypeData%dXdu)) then + deallocate(TC_MiscVarTypeData%dXdu) + end if + if (allocated(TC_MiscVarTypeData%dUdu)) then + deallocate(TC_MiscVarTypeData%dUdu) + end if + if (allocated(TC_MiscVarTypeData%dUdy)) then + deallocate(TC_MiscVarTypeData%dUdy) + end if + if (allocated(TC_MiscVarTypeData%XB)) then + deallocate(TC_MiscVarTypeData%XB) + end if + if (allocated(TC_MiscVarTypeData%Jac)) then + deallocate(TC_MiscVarTypeData%Jac) + end if + if (allocated(TC_MiscVarTypeData%IPIV)) then + deallocate(TC_MiscVarTypeData%IPIV) + end if + if (allocated(TC_MiscVarTypeData%dq)) then + deallocate(TC_MiscVarTypeData%dq) + end if + if (allocated(TC_MiscVarTypeData%dx)) then + deallocate(TC_MiscVarTypeData%dx) + end if + if (allocated(TC_MiscVarTypeData%du)) then + deallocate(TC_MiscVarTypeData%du) + end if +end subroutine + +subroutine FAST_PackTC_MiscVarType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_MiscVarType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%q)) + if (allocated(InData%q)) then + call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPack(Buf, InData%q) + end if + call RegPack(Buf, allocated(InData%qn)) + if (allocated(InData%qn)) then + call RegPackBounds(Buf, 2, lbound(InData%qn), ubound(InData%qn)) + call RegPack(Buf, InData%qn) + end if + 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 + call RegPack(Buf, allocated(InData%xn)) + if (allocated(InData%xn)) then + call RegPackBounds(Buf, 1, lbound(InData%xn), ubound(InData%xn)) + call RegPack(Buf, InData%xn) + end if + call RegPack(Buf, allocated(InData%dxdt)) + if (allocated(InData%dxdt)) then + call RegPackBounds(Buf, 1, lbound(InData%dxdt), ubound(InData%dxdt)) + call RegPack(Buf, InData%dxdt) + end if + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + call RegPack(Buf, InData%u) + end if + call RegPack(Buf, allocated(InData%un)) + if (allocated(InData%un)) then + call RegPackBounds(Buf, 1, lbound(InData%un), ubound(InData%un)) + call RegPack(Buf, InData%un) + end if + call RegPack(Buf, allocated(InData%u_tmp)) + if (allocated(InData%u_tmp)) then + call RegPackBounds(Buf, 1, lbound(InData%u_tmp), ubound(InData%u_tmp)) + call RegPack(Buf, InData%u_tmp) + end if + 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 + call RegPack(Buf, allocated(InData%dYdx)) + if (allocated(InData%dYdx)) then + call RegPackBounds(Buf, 2, lbound(InData%dYdx), ubound(InData%dYdx)) + call RegPack(Buf, InData%dYdx) + end if + call RegPack(Buf, allocated(InData%dYdu)) + if (allocated(InData%dYdu)) then + call RegPackBounds(Buf, 2, lbound(InData%dYdu), ubound(InData%dYdu)) + call RegPack(Buf, InData%dYdu) + end if + call RegPack(Buf, allocated(InData%dXdx)) + if (allocated(InData%dXdx)) then + call RegPackBounds(Buf, 2, lbound(InData%dXdx), ubound(InData%dXdx)) + call RegPack(Buf, InData%dXdx) + end if + call RegPack(Buf, allocated(InData%dXdu)) + if (allocated(InData%dXdu)) then + call RegPackBounds(Buf, 2, lbound(InData%dXdu), ubound(InData%dXdu)) + call RegPack(Buf, InData%dXdu) + end if + call RegPack(Buf, allocated(InData%dUdu)) + if (allocated(InData%dUdu)) then + call RegPackBounds(Buf, 2, lbound(InData%dUdu), ubound(InData%dUdu)) + call RegPack(Buf, InData%dUdu) + end if + call RegPack(Buf, allocated(InData%dUdy)) + if (allocated(InData%dUdy)) then + call RegPackBounds(Buf, 2, lbound(InData%dUdy), ubound(InData%dUdy)) + call RegPack(Buf, InData%dUdy) + end if + call RegPack(Buf, allocated(InData%XB)) + if (allocated(InData%XB)) then + call RegPackBounds(Buf, 2, lbound(InData%XB), ubound(InData%XB)) + call RegPack(Buf, InData%XB) + end if + call RegPack(Buf, allocated(InData%Jac)) + if (allocated(InData%Jac)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac), ubound(InData%Jac)) + call RegPack(Buf, InData%Jac) + end if + call RegPack(Buf, allocated(InData%IPIV)) + if (allocated(InData%IPIV)) then + call RegPackBounds(Buf, 1, lbound(InData%IPIV), ubound(InData%IPIV)) + call RegPack(Buf, InData%IPIV) + end if + call RegPack(Buf, InData%IterTotal) + call RegPack(Buf, InData%IterUntilUJac) + call RegPack(Buf, InData%StepsUntilUJac) + 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 + 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 + 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 +end subroutine + +subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_MiscVarType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%q)) deallocate(OutData%q) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%qn)) deallocate(OutData%qn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%xn)) deallocate(OutData%xn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dxdt)) deallocate(OutData%dxdt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dxdt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dxdt) + if (RegCheckErr(Buf, RoutineName)) return end if - call RegPack(Buf, allocated(InData%x_eig_magnitude)) - if (allocated(InData%x_eig_magnitude)) then - call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude), ubound(InData%x_eig_magnitude)) - call RegPack(Buf, InData%x_eig_magnitude) + 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 + call RegUnpack(Buf, OutData%u) + if (RegCheckErr(Buf, RoutineName)) return end if - call RegPack(Buf, allocated(InData%x_eig_phase)) - if (allocated(InData%x_eig_phase)) then - call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase), ubound(InData%x_eig_phase)) - call RegPack(Buf, InData%x_eig_phase) + if (allocated(OutData%un)) deallocate(OutData%un) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%un(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%un.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%un) + if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%u_tmp)) deallocate(OutData%u_tmp) + call RegUnpack(Buf, IsAllocAssoc) 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 - call RegUnpack(Buf, OutData%CheckpointRoot) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_tmp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_tmp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%u_tmp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MatlabFileName) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dYdx)) deallocate(OutData%dYdx) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinModes) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dYdx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dYdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dYdx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dYdu)) deallocate(OutData%dYdu) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dYdu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dYdu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dYdu) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dXdx)) deallocate(OutData%dXdx) 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%VTKModes(LB(1):UB(1)),stat=stat) + allocate(OutData%dXdx(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dXdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%VTKModes) + call RegUnpack(Buf, OutData%dXdx) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%VTKLinTim) + if (allocated(OutData%dXdu)) deallocate(OutData%dXdu) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKNLinTimes) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dXdu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dXdu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dXdu) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dUdu)) deallocate(OutData%dUdu) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinScale) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dUdu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dUdu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dUdu) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dUdy)) deallocate(OutData%dUdy) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinPhase) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dUdy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dUdy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dUdy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%XB)) deallocate(OutData%XB) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%XB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%XB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac)) deallocate(OutData%Jac) 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%DampingRatio(LB(1):UB(1)),stat=stat) + allocate(OutData%Jac(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%DampingRatio) + call RegUnpack(Buf, OutData%Jac) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) + if (allocated(OutData%IPIV)) deallocate(OutData%IPIV) call 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) + allocate(OutData%IPIV(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IPIV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%NaturalFreq_Hz) + call RegUnpack(Buf, OutData%IPIV) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) + call RegUnpack(Buf, OutData%IterTotal) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IterUntilUJac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StepsUntilUJac) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%dq)) deallocate(OutData%dq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) + call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DampedFreq_Hz(LB(1):UB(1)),stat=stat) + allocate(OutData%dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%DampedFreq_Hz) + call RegUnpack(Buf, OutData%dq) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) + if (allocated(OutData%dx)) deallocate(OutData%dx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) + call RegUnpackBounds(Buf, 1, 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) + allocate(OutData%dx(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%x_eig_magnitude) + call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) + if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) + call RegUnpackBounds(Buf, 1, 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) + allocate(OutData%du(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%x_eig_phase) + call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine @@ -1517,6 +2991,9 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder + call FAST_CopyTC_ParameterType(SrcParamData%Solver, DstParamData%Solver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1532,6 +3009,8 @@ subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyVTK_ModeShapeType(ParamData%VTK_modes, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyTC_ParameterType(ParamData%Solver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackParam(Buf, Indata) @@ -1633,6 +3112,7 @@ subroutine FAST_PackParam(Buf, Indata) call RegPack(Buf, InData%Lin_NumMods) call RegPack(Buf, InData%Lin_ModOrder) call RegPack(Buf, InData%LinInterpOrder) + call FAST_PackTC_ParameterType(Buf, InData%Solver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1827,6 +3307,7 @@ subroutine FAST_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%LinInterpOrder) if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackTC_ParameterType(Buf, OutData%Solver) ! Solver end subroutine subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) @@ -7426,6 +8907,22 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end do end if + if (allocated(SrcBeamDyn_DataData%dxdt)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%dxdt) + UB(1:1) = ubound(SrcBeamDyn_DataData%dxdt) + if (.not. allocated(DstBeamDyn_DataData%dxdt)) then + allocate(DstBeamDyn_DataData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcBeamDyn_DataData%dxdt(i1), DstBeamDyn_DataData%dxdt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcBeamDyn_DataData%xd)) then LB(1:2) = lbound(SrcBeamDyn_DataData%xd) UB(1:2) = ubound(SrcBeamDyn_DataData%xd) @@ -7632,6 +9129,15 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%x) end if + if (allocated(BeamDyn_DataData%dxdt)) then + LB(1:1) = lbound(BeamDyn_DataData%dxdt) + UB(1:1) = ubound(BeamDyn_DataData%dxdt) + do i1 = LB(1), UB(1) + call BD_DestroyContState(BeamDyn_DataData%dxdt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%dxdt) + end if if (allocated(BeamDyn_DataData%xd)) then LB(1:2) = lbound(BeamDyn_DataData%xd) UB(1:2) = ubound(BeamDyn_DataData%xd) @@ -7755,6 +9261,15 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if + call RegPack(Buf, allocated(InData%dxdt)) + if (allocated(InData%dxdt)) then + call RegPackBounds(Buf, 1, lbound(InData%dxdt), ubound(InData%dxdt)) + LB(1:1) = lbound(InData%dxdt) + UB(1:1) = ubound(InData%dxdt) + do i1 = LB(1), UB(1) + call BD_PackContState(Buf, InData%dxdt(i1)) + end do + end if call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) @@ -7889,6 +9404,21 @@ subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) end do end do end if + if (allocated(OutData%dxdt)) deallocate(OutData%dxdt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dxdt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackContState(Buf, OutData%dxdt(i1)) ! dxdt + end do + end if if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8085,6 +9615,9 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + call ED_CopyContState(SrcElastoDyn_DataData%dxdt, DstElastoDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return LB(1:1) = lbound(SrcElastoDyn_DataData%xd) UB(1:1) = ubound(SrcElastoDyn_DataData%xd) do i1 = LB(1), UB(1) @@ -8184,6 +9717,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + call ED_DestroyContState(ElastoDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) LB(1:1) = lbound(ElastoDyn_DataData%xd) UB(1:1) = ubound(ElastoDyn_DataData%xd) do i1 = LB(1), UB(1) @@ -8247,6 +9782,7 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%x(i1)) end do + call ED_PackContState(Buf, InData%dxdt) LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) @@ -8307,6 +9843,7 @@ subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) do i1 = LB(1), UB(1) call ED_UnpackContState(Buf, OutData%x(i1)) ! x end do + call ED_UnpackContState(Buf, OutData%dxdt) ! dxdt LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) @@ -9696,6 +11233,9 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + call SD_CopyContState(SrcSubDyn_DataData%dxdt, DstSubDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return LB(1:1) = lbound(SrcSubDyn_DataData%xd) UB(1:1) = ubound(SrcSubDyn_DataData%xd) do i1 = LB(1), UB(1) @@ -9795,6 +11335,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + call SD_DestroyContState(SubDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) LB(1:1) = lbound(SubDyn_DataData%xd) UB(1:1) = ubound(SubDyn_DataData%xd) do i1 = LB(1), UB(1) @@ -9858,6 +11400,7 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call SD_PackContState(Buf, InData%x(i1)) end do + call SD_PackContState(Buf, InData%dxdt) LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) @@ -9918,6 +11461,7 @@ subroutine FAST_UnPackSubDyn_Data(Buf, OutData) do i1 = LB(1), UB(1) call SD_UnpackContState(Buf, OutData%x(i1)) ! x end do + call SD_UnpackContState(Buf, OutData%dxdt) ! dxdt LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) @@ -13837,6 +15381,8 @@ subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMisc' @@ -13857,12 +15403,33 @@ subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call FAST_CopyMiscLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%Modules)) then + LB(1:1) = lbound(SrcMiscData%Modules) + UB(1:1) = ubound(SrcMiscData%Modules) + if (.not. allocated(DstMiscData%Modules)) then + allocate(DstMiscData%Modules(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Modules.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModDataType(SrcMiscData%Modules(i1), DstMiscData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FAST_CopyTC_MiscVarType(SrcMiscData%Solver, DstMiscData%Solver, 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) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMisc' @@ -13872,12 +15439,25 @@ subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyMiscLinType(MiscData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%Modules)) then + LB(1:1) = lbound(MiscData%Modules) + UB(1:1) = ubound(MiscData%Modules) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModDataType(MiscData%Modules(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Modules) + end if + call FAST_DestroyTC_MiscVarType(MiscData%Solver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TiLstPrn) call RegPack(Buf, InData%t_global) @@ -13890,6 +15470,16 @@ subroutine FAST_PackMisc(Buf, Indata) call RegPack(Buf, InData%calcJacobian) call FAST_PackExternInputType(Buf, InData%ExternInput) call FAST_PackMiscLinType(Buf, InData%Lin) + call RegPack(Buf, allocated(InData%Modules)) + if (allocated(InData%Modules)) then + call RegPackBounds(Buf, 1, lbound(InData%Modules), ubound(InData%Modules)) + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModDataType(Buf, InData%Modules(i1)) + end do + end if + call FAST_PackTC_MiscVarType(Buf, InData%Solver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -13897,6 +15487,10 @@ subroutine FAST_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%TiLstPrn) if (RegCheckErr(Buf, RoutineName)) return @@ -13918,6 +15512,22 @@ subroutine FAST_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call FAST_UnpackExternInputType(Buf, OutData%ExternInput) ! ExternInput call FAST_UnpackMiscLinType(Buf, OutData%Lin) ! Lin + if (allocated(OutData%Modules)) deallocate(OutData%Modules) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Modules(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modules.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModDataType(Buf, OutData%Modules(i1)) ! Modules + end do + end if + call FAST_UnpackTC_MiscVarType(Buf, OutData%Solver) ! Solver end subroutine subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 new file mode 100644 index 0000000000..37960a7647 --- /dev/null +++ b/modules/openfast-library/src/Solver.f90 @@ -0,0 +1,1233 @@ +module Solver + +use FAST_Solver +use FAST_ModTypes +use FAST_Eval +use NWTC_LAPACK +use ElastoDyn +use BeamDyn +use SubDyn +use AeroDyn +use AeroDyn14 +use ServoDyn +use SC_DataEx + +implicit none + +private + +! q matrix column indices (displacement, velocity, accel, algo accel) +integer(IntKi), parameter :: COL_D = 1, COL_V = 2, COL_A = 3, COL_AA = 4 + +! Tight coupling modules +integer(IntKi), parameter :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] + +public Solver_Init, Solver_Step0, Solver_Step + +! Transfer Module Flags +integer(IntKi), parameter :: XM_x = 1, & + XM_dxdt = 2, & + XM_dYdx = 4, & + XM_dXdx = 8, & + XM_dYdu = 16, & + XM_dXdu = 32 + +contains + +subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) + + type(TC_ParameterType), intent(inout) :: p !< Parameters + type(TC_MiscVarType), intent(out) :: m !< Misc variables for optimization (not copied in glue code) + type(ModDataType), intent(inout) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Solver_Init' + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + integer(IntKi) :: i, j, k, n + integer(IntKi) :: NumX, NumU, NumY, NumQ, NumJac + integer(IntKi), allocatable :: iq(:), modIDs(:) + logical :: isLoad + logical, allocatable :: isLoadTight(:), isLoadOption1(:) + + !---------------------------------------------------------------------------- + ! Calculate generalized alpha parameters + !---------------------------------------------------------------------------- + + p%AccBlend = 1.0_R8Ki + + p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) + p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) + p%Gamma = 0.5_ReKi - p%AlphaM + p%AlphaF + p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2/4.0_R8Ki + + p%C(1) = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + p%C(2) = p%DT*p%Gamma*p%C(1) + p%C(3) = p%DT**2*p%Beta*p%C(1) + + !---------------------------------------------------------------------------- + ! Module substepping + !---------------------------------------------------------------------------- + + ! Loop through module data + do i = 1, size(ModData) + + ! Calculate the number of substeps + ModData(i)%SubSteps = nint(p%DT/ModData(i)%DT) + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData(i)%DT, p%DT)) cycle + + ! If the module time step is greater than the global time step, set error + if (ModData(i)%DT > p%DT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData(i)%Abbr)// & + " module time step ("//trim(Num2LStr(ModData(i)%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(p%DT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(p%DT, ModData(i)%DT*ModData(i)%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData(i)%Abbr)// & + " module time step ("//trim(Num2LStr(ModData(i)%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(p%DT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end do + + !---------------------------------------------------------------------------- + ! Calculate Variable cateogries and global indices + ! TODO: reorder to improve data locality + !---------------------------------------------------------------------------- + + NumX = 0 + do i = 1, size(ModData) + do j = 1, size(ModData(i)%Vars%x) + ModData(i)%Vars%x(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%x(j)%Field) + ModData(i)%Vars%x(j)%iGbl = [(NumX + k, k=1, ModData(i)%Vars%x(j)%Size)] + NumX = NumX + ModData(i)%Vars%x(j)%Size + end do + call MV_CollectGlobalIndices(ModData(i)%Vars%x, ModData(i)%Vars%ixg) + end do + + NumU = 0 + do i = 1, size(ModData) + do j = 1, size(ModData(i)%Vars%u) + ModData(i)%Vars%u(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%u(j)%Field) + ModData(i)%Vars%u(j)%iGbl = [(NumU + k, k=1, ModData(i)%Vars%u(j)%Size)] + NumU = NumU + ModData(i)%Vars%u(j)%Size + end do + call MV_CollectGlobalIndices(ModData(i)%Vars%u, ModData(i)%Vars%iug) + end do + + NumY = 0 + do i = 1, size(ModData) + do j = 1, size(ModData(i)%Vars%y) + ModData(i)%Vars%y(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%y(j)%Field) + ModData(i)%Vars%y(j)%iGbl = [(NumY + k, k=1, ModData(i)%Vars%y(j)%Size)] + NumY = NumY + ModData(i)%Vars%y(j)%Size + end do + call MV_CollectGlobalIndices(ModData(i)%Vars%y, ModData(i)%Vars%iyg) + end do + + !---------------------------------------------------------------------------- + ! Allocate storage + !---------------------------------------------------------------------------- + + ! State and State Derivative + call AllocAry(m%x, NumX, "m%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%xn, NumX, "m%xn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dx, NumX, "m%dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dxdt, NumX, "m%dxdt", ErrStat2, ErrMsg2); if (Failed()) return + m%x = 0.0_R8Ki + m%dx = 0.0_R8Ki + m%dxdt = 0.0_R8Ki + + ! Inputs and Input Temporary + call AllocAry(m%u, NumU, "m%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%un, NumU, "m%un", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%du, NumU, "m%du", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%u_tmp, NumU, "m%u_tmp", ErrStat2, ErrMsg2); if (Failed()) return + m%u = 0.0_R8Ki + m%un = 0.0_R8Ki + m%du = 0.0_R8Ki + m%u_tmp = 0.0_R8Ki + + ! Outputs + call AllocAry(m%y, NumY, "m%y", ErrStat2, ErrMsg2); if (Failed()) return + m%y = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Allocate q storage for generalized alpha algorithm + ! This matrix stores equation state in an (N,4) array where: + ! - N is the number of equations (rows) + ! - Column 1 is position + ! - Column 2 is velocity + ! - Column 3 is acceleration + ! - Column 4 is generalized alpha algorithmic acceleration + !---------------------------------------------------------------------------- + + ! Allocate storage for matrix mapping mapping x to q + call AllocAry(p%ixqd, 3, NumX, "p%ixqd", ErrStat2, ErrMsg2); if (Failed()) return + p%ixqd = 0 + + ! Initialize number of q states (ignore derivatives) + NumQ = 0 + n = 0 + + ! Loop through modules + do i = 1, size(ModData) + + ! Allocate iq to store q index for each variable + call AllocAry(iq, size(ModData(i)%Vars%x), "iq", ErrStat2, ErrMsg2); if (Failed()) return + iq = 0 + + ! Skip modules that aren't in tight coupling + if (all(ModData(i)%ID /= TC_Modules)) cycle + + ! Loop through state variables + do j = 1, size(ModData(i)%Vars%x) + + ! Skip variables which already have a q index + if (iq(j) /= 0) cycle + + ! Skip load variables (force and moment) + if (any(ModData(i)%Vars%x(j)%Field == LoadFields)) cycle + + ! Set q index for variable and update number + iq(j) = NumQ + 1 + NumQ = NumQ + ModData(i)%Vars%x(j)%Size + + ! Loop through remaining vars if the names match + do k = i + 1, size(ModData(i)%Vars%x) + + ! If names are different then they don't match, skip + if (ModData(i)%Vars%x(j)%Name /= ModData(i)%Vars%x(k)%Name) cycle + + ! If field is not the same or a derivative of current field, skip + select case (ModData(i)%Vars%x(j)%Field) + case (VF_Orientation) + if (ModData(i)%Vars%x(k)%Field /= VF_Orientation) cycle + case (VF_TransDisp, VF_TransVel, VF_TransAcc) + if (all(ModData(i)%Vars%x(k)%Field /= TransFields)) cycle + case (VF_AngularDisp, VF_AngularVel, VF_AngularAcc) + if (all(ModData(i)%Vars%x(k)%Field /= AngularFields)) cycle + case (VF_Force, VF_Moment) + cycle + end select + + ! Copy q index + iq(k) = iq(j) + + end do + end do + + ! Loop through state variables and build mapping array between x and q + ! ixqd is 3xN where each row is [global x array index, q matrix row, q matrix col] + do j = 1, size(ModData(i)%Vars%x) + do k = 1, ModData(i)%Vars%x(j)%Size + n = n + 1 + p%ixqd(:, n) = [ModData(i)%Vars%x(j)%iGbl(k), iq(j) + k - 1, ModData(i)%Vars%x(j)%DerivOrder + 1] + end do + end do + + ! Deallocate iq for use by next module + deallocate (iq) + end do + + ! Remove x->q indicies that aren't set + p%ixqd = p%ixqd(:, 1:n) + + ! Allocate/initialize global q storage + call AllocAry(m%q, NumQ, 4, "m%q", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%qn, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dq, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return + m%q = 0.0_R8Ki + m%qn = 0.0_R8Ki + m%dq = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Mapping arrays + !---------------------------------------------------------------------------- + + ! Calculate index mapping arrays for X1Tight and X2Tight + call AllocAry(p%iX1Tight, 0, "p%iX1Tight", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(p%iX2Tight, 0, "p%iX2Tight", ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(ModData) + do j = 1, size(ModData(i)%Vars%x) + if (ModData(i)%Vars%x(j)%Cat == VC_Tight) then + select case (ModData(i)%Vars%x(j)%DerivOrder) + case (0) + p%iX1Tight = [p%iX1Tight, ModData(i)%Vars%x(j)%iGbl] + case (1) + p%iX2Tight = [p%iX2Tight, ModData(i)%Vars%x(j)%iGbl] + end select + end if + end do + end do + + ! Calculate index mapping arrays for U^Tight and U^Option1 + call AllocAry(p%iUTight, 0, "p%iUTight", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(p%iUOpt1, 0, "p%iUOpt1", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(isLoadTight, 0, "isLoadTight", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(isLoadOption1, 0, "isLoadOption1", ErrStat2, ErrMsg2); if (Failed()) return + ! do i = 1, size(ModData) + ! do j = 1, size(ModData(i)%Vars%u) + ! isLoad = any(LoadFields == ModData(i)%Vars%u(j)%Field) + ! select case (ModData(i)%Vars%u(j)%Cat) + ! case (VC_Tight) + ! p%iUTight = [p%iUTight, ModData(i)%Vars%u(j)%iGbl] + ! isLoadTight = [isLoadTight, spread(isLoad, 1, ModData(i)%Vars%u(j)%Size)] + ! case (VC_Option1) + ! p%iUOpt1 = [p%iUOpt1, ModData(i)%Vars%u(j)%iGbl] + ! isLoadOption1 = [isLoadOption1, spread(isLoad, 1, ModData(i)%Vars%u(j)%Size)] + ! end select + ! end do + ! end do + + ! Calculate index mapping arrays for y^Tight and y^Option1 + call AllocAry(p%iyTight, 0, "p%iyTight", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(p%iyOpt1, 0, "p%iyOpt1", ErrStat2, ErrMsg2); if (Failed()) return + ! do i = 1, size(ModData) + ! do j = 1, size(ModData(i)%Vars%u) + ! select case (ModData(i)%Vars%u(j)%Cat) + ! case (VC_Tight) + ! p%iyTight = [p%iyTight, ModData(i)%Vars%u(j)%iGbl] + ! case (VC_Option1) + ! p%iyOpt1 = [p%iyOpt1, ModData(i)%Vars%u(j)%iGbl] + ! end select + ! end do + ! end do + + !---------------------------------------------------------------------------- + ! Allocate Jacobian matrices + !---------------------------------------------------------------------------- + + call AllocAry(m%dYdx, NumY, NumX, "m%dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dYdu, NumY, NumU, "m%dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dXdx, NumX, NumX, "m%dXdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dXdu, NumX, NumU, "m%dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dUdu, NumU, NumU, "m%dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dUdy, NumU, NumY, "m%dUdy", ErrStat2, ErrMsg2); if (Failed()) return + + m%dYdx = 0.0_R8Ki + m%dYdu = 0.0_R8Ki + m%dXdx = 0.0_R8Ki + m%dXdu = 0.0_R8Ki + m%dUdu = 0.0_R8Ki + m%dUdy = 0.0_R8Ki + + ! Populate dUdu + do i = 1, NumU + m%dUdu(i, i) = 1.0_R8Ki + end do + + ! TODO: Figure out how to calculate from mesh mapping + ! Populate dUdy based on output/input transfer relationships + ! do i = 1, size(p%Vars%u) + ! do j = 1, size(p%Vars%u(i)%iy) + ! do k = 1, size(p%Vars%u(i)%iGbl) + ! m%dUdy(p%Vars%u(i)%iGbl(k), p%Vars%u(i)%iy(k, j)) = -1.0_R8Ki + ! end do + ! end do + ! end do + + !---------------------------------------------------------------------------- + ! Allocate Jacobian matrix, RHS, and Delta + !---------------------------------------------------------------------------- + + ! Initialize size of system + NumJac = 0 + + ! Allocate and initialize indices of q vars in Jacobian matrix + p%iJX2 = [(NumJac + i, i=1, size(p%iX2Tight))] + NumJac = NumJac + size(p%iJX2) + + ! Allocate and initialize indices of tight coupling vars in Jacobian matrix + p%iJT = [(NumJac + i, i=1, size(p%iUTight))] + NumJac = NumJac + size(p%iJT) + + ! Allocate and initialize indices of option 1 vars in Jacobian matrix + p%iJ1 = [(NumJac + i, i=1, size(p%iUOpt1))] + NumJac = NumJac + size(p%iJ1) + + ! Get Jacobian indicies containing loads + p%iJL = [pack(p%iJT, isLoadTight), pack(p%iJ1, isLoadOption1)] + + ! Allocate Macobian matrix, RHS/X matrix, Pivot array + call AllocAry(m%Jac, NumJac, NumJac, "m%Jac", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%XB, NumJac, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%IPIV, NumJac, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Module ordering for solve + !---------------------------------------------------------------------------- + + ! Get array of module IDs + modIDs = [(ModData(i)%ID, i=1, size(ModData))] + + ! Allocate ordering array for all modules + p%iModAll = [pack([(i, i=1, size(ModData))], ModIDs == Module_SrvD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_AD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & + pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + + p%iModTC = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & + pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + + ! TODO: Add other modules + p%iModOpt2 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED)] + + ! TODO: Add other modules + p%iModOpt1 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED)] + + ! Option 1 modules that require input solve and update states + ! TODO: Add aerodyn with hydrodynamics + p%iModOpt1US = [pack([(i, i=1, size(ModData))], ModIDs == Module_ExtPtfm), & + pack([(i, i=1, size(ModData))], ModIDs == Module_HD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_Orca)] + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + pure function VarCategory(ModID, VarField) result(VarCat) + integer(IntKi), intent(in) :: ModID, VarField + integer(IntKi) :: VarCat + ! If tight coupling module, then category is Tight + if (any(ModID == TC_Modules)) then + VarCat = VC_Tight + return + end if + select case (VarField) + case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position + VarCat = VC_Option2 + case (VF_TransVel, VF_AngularVel) ! Velocity + VarCat = VC_Option2 + case (VF_TransAcc, VF_AngularAcc) ! Acceleration + VarCat = VC_Option1 + case default + VarCat = VC_None + end select + end function +end subroutine + +subroutine Solver_TransferXtoQ(ixqd, x, q) + integer(IntKi), intent(in) :: ixqd(:, :) + real(R8Ki), intent(in) :: x(:) + real(R8Ki), intent(inout) :: q(:, :) + integer(IntKi) :: i + do i = 1, size(ixqd, dim=2) + q(ixqd(2, i), ixqd(3, i)) = x(ixqd(1, i)) + end do +end subroutine + +subroutine Solver_TransferQtoX(ixqd, q, x) + integer(IntKi), intent(in) :: ixqd(:, :) + real(R8Ki), intent(in) :: q(:, :) + real(R8Ki), intent(inout) :: x(:) + integer(IntKi) :: i + do i = 1, size(ixqd, dim=2) + x(ixqd(1, i)) = q(ixqd(2, i), ixqd(3, i)) + end do +end subroutine + +pure function NeedWriteOutput(n_t_global, t_global, t_initial, n_DT_Out) result(WriteNeeded) + integer(IntKi), intent(in) :: n_t_global !< Current global time step + real(DbKi), intent(in) :: t_initial !< Initial time + real(DbKi), intent(in) :: t_global !< Current global time + integer(IntKi), intent(in) :: n_DT_Out !< Write output every n steps + logical :: WriteNeeded !< Function result; if true, WriteOutput values are needed on this time step + + ! note that if TStart isn't an multiple of DT_out, we will not necessarially start output to the file at TStart + if (t_global >= t_initial) then + WriteNeeded = MOD(n_t_global, n_DT_Out) == 0 + else + WriteNeeded = .false. + end if +end function NeedWriteOutput + +subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(inout) :: m !< Misc variables + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Solver_Step0' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + real(R8Ki), allocatable :: accel(:) + real(R8Ki) :: diff + logical :: converged + integer(IntKi), parameter :: n_t_global = -1 ! loop counter + integer(IntKi), parameter :: n_t_global_next = 0 ! loop counter + real(DbKi) :: t_initial ! next simulation time + real(DbKi) :: t_global_next ! next simulation time + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Miscellaneous initial step + !---------------------------------------------------------------------------- + + t_initial = Turbine%m_FAST%t_global + t_global_next = t_initial + n_t_global_next*p%DT + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, t_initial, Turbine%p_FAST%n_DT_Out) + + if (Turbine%p_FAST%WrSttsTime) then + call SimStatus_FirstTime(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%SimStrtTime, Turbine%m_FAST%UsrTime2, t_initial, & + Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + + ! TODO: Add SrvD_SetExternalInputs + ! TODO: Add SeaSt_CalcOutput + + !---------------------------------------------------------------------------- + ! Calculate initial accelerations + !---------------------------------------------------------------------------- + + ! Transfer initial state from modules to solver + call TransferFromModules(p%iModTC, ModData, STATE_CURR, Turbine, x=m%x) + + ! Transfer initial state to next state q matrix (qn) + ! The qn matrix is being used because the solution step routine predicts + ! the the step starting state, q, from qn. + call Solver_TransferXtoQ(p%ixqd, m%x, m%qn) + + ! Allocate acceleration array which will be used to check for convergence + ! of initial acceleration. Transfer initial accelerations from q matrix + call AllocAry(accel, size(m%qn, dim=2), "accel", ErrStat2, ErrMsg2); if (Failed()) return + accel = m%qn(:, COL_A) + + ! Loop until initial accelerations are converged, or max iterations are reached. + ! TODO: may need a separate variable for max initial acceleration convergence iterations + converged = .false. + k = 1 + do while ((.not. converged) .and. (k <= p%MaxConvIter)) + + ! Transfer inputs and calculate outputs for all modules (use current state) + call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_CURR, & + EM_InputSolve + EM_CalcOutput, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + ! Calculate continuous state derivatives for tight coupling modules (use current state) + call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_CURR, & + EM_CalcContStateDeriv, Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return + + ! Copy acceleration (derivative of velocity) to acceleration array. + ! Loop through x->q index array and transfer derivative of + ! velocity variables (deriv=COL_V) to the acceleration column + do i = 1, size(p%ixqd, dim=2) + if (p%ixqd(3, i) == COL_V) accel(p%ixqd(2, i)) = m%dxdt(p%ixqd(1, i)) + end do + + ! Calculate diff as L2 norm of current and new accelerations + diff = TwoNorm(accel - m%qn(:, COL_A)) + + ! If difference is less than converence tolerance, set flag and exit loop + if (diff < p%ConvTol) converged = .true. + + ! Update acceleration in q matrix + m%qn(:, COL_A) = accel + + ! Increment iteration counter + k = k + 1 + end do + + ! Print warning if not converged + if (.not. converged) then + call WrScr("Solver: initial accel not converged, diff="//Num2LStr(diff)//", tol="//Num2LStr(p%ConvTol)) + end if + + ! Initialize algorithmic acceleration from actual acceleration + m%qn(:, COL_AA) = m%qn(:, COL_A) + ! m%qn(:, COL_A) = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Initialize module input and state arrays for interpolation/extrapolation + !---------------------------------------------------------------------------- + + call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_CURR, & + EM_InitIO, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Calculate inititial Jacobian + !---------------------------------------------------------------------------- + + ! Calculate the Jacobians for TC modules + call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_CURR, & + EM_JacobianPContState + EM_JacobianPInput, Turbine, ErrStat2, ErrMsg2, & + dYdx=m%dYdx, dXdx=m%dXdx, dYdu=m%dYdu, dXdu=m%dXdu); if (Failed()) return + + ! Calculate the Jacobian + call CalcJacobian(p, m, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Supercontroller + !---------------------------------------------------------------------------- + + ! TODO: add SC_DX_SetInputs + + !---------------------------------------------------------------------------- + ! Write Output + !---------------------------------------------------------------------------- + + call WriteOutputToFile(n_t_global_next, t_initial, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: n_t_global !< global time step + real(DbKi), intent(in) :: t_initial !< Initial simulation time + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(inout) :: m !< Misc variables + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Solver_Step' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: NumCorrections ! number of corrections for this time step + integer(IntKi) :: iterConv, iterCorr + logical :: update_jacobian + real(ReKi) :: delta_norm + real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + integer(IntKi) :: n_t_global_next ! n_t_global + 1 + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Miscellaneous step updates + !---------------------------------------------------------------------------- + + ! Calculate the next global time step number and time + n_t_global_next = n_t_global + 1 + t_global_next = t_initial + n_t_global_next*p%DT + + ! Determine if output should be written in this step + Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, t_initial, Turbine%p_FAST%n_DT_Out) + + ! Set number of corrections to be used for this time step + if (Turbine%p_FAST%CompElast /= Module_BD) then + ! Use input file value if BeamDyn is not used + NumCorrections = Turbine%p_FAST%NumCrctn + else if (n_t_global == 0) then + ! BD accelerations have fewer spikes on the first several time steps with these corrections + NumCorrections = max(Turbine%p_FAST%NumCrctn, 16) + else if (n_t_global <= 2) then + ! Use at least 1 correction on the first 3 steps (the 2 should probably be related to Turbine%p_FAST%InterpOrder) + NumCorrections = max(Turbine%p_FAST%NumCrctn, 1) + else + ! Use input file value on subsequent steps + NumCorrections = Turbine%p_FAST%NumCrctn + end if + + ! Decrement number of time steps before updating the Jacobian + m%StepsUntilUJac = m%StepsUntilUJac - 1 + + !---------------------------------------------------------------------------- + ! Extrapolate/interpolate inputs for all modules + !---------------------------------------------------------------------------- + + call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_PRED, & + EM_ExtrapInterp, Turbine, ErrStat2, ErrMsg2) + + !---------------------------------------------------------------------------- + ! Prediction - guess solution state variables at end of time step + !---------------------------------------------------------------------------- + + ! Calculate displacements, velocities, and accelerations for next step + associate (q => m%qn(:, 1), qd => m%qn(:, 2), qdd => m%qn(:, 3), aa => m%qn(:, 4), & + nq => m%q(:, 1), nqd => m%q(:, 2), nqdd => m%q(:, 3), naa => m%q(:, 4)) + nqdd = qdd*p%AccBlend ! Acceleration + naa = ((1.0_R8Ki - p%AlphaF)*nqdd + p%AlphaF*qdd - p%AlphaM*aa)/(1 - p%AlphaM) ! Algorithmic acceleration + nq = q + p%DT*qd + p%DT**2*(0.5 - p%Beta)*aa + p%DT**2*p%Beta*naa ! Displacment + nqd = qd + p%DT*(1 - p%Gamma)*aa + p%DT*p%Gamma*naa ! Velocity + end associate + + ! Transfer algorithm matrix to solver states + call Solver_TransferQtoX(p%ixqd, m%q, m%x) + + !---------------------------------------------------------------------------- + ! Correction Iterations + !---------------------------------------------------------------------------- + + ! Loop through correction iterations + iterCorr = 0 + do while (iterCorr <= p%NumCrctn) + + ! Copy state for correction step + m%qn = m%q + m%xn = m%x + + ! Reset state matrix delta + m%dq = 0.0_R8Ki + + ! Option 2 calculation: + ! - Input Solve + ! - Update states from current to predicted (set new states in TC modules) + ! - Calculate output + call FAST_EvalModules(t_initial, n_t_global, p%iModOpt2, ModData, STATE_PRED, & + EM_UpdateStates + EM_InputSolve + EM_CalcOutput, & + Turbine, ErrStat2, ErrMsg2, x=m%xn); if (Failed()) return + + ! Option 1 modules not in Option 2: + ! - Input solve + ! - Update states + call FAST_EvalModules(t_initial, n_t_global, p%iModOpt1US, ModData, STATE_PRED, & + EM_InputSolve + EM_UpdateStates, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + ! Get all current inputs + call TransferFromModules(p%iModAll, ModData, STATE_PRED, Turbine, u=m%un) + + !------------------------------------------------------------------------- + ! Convergence Iterations + !------------------------------------------------------------------------- + + ! Loop through convergence iterations + do iterConv = 0, p%MaxConvIter + + ! Decrement number of iterations before updating the Jacobian + m%IterUntilUJac = m%IterUntilUJac - 1 + + !---------------------------------------------------------------------- + ! Option 1 calculate outputs + !---------------------------------------------------------------------- + + call FAST_EvalModules(t_initial, n_t_global, p%iModOpt1, ModData, STATE_PRED, & + EM_CalcOutput, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------- + ! If iteration limit reached, exit loop + !---------------------------------------------------------------------- + + if (iterConv >= p%MaxConvIter) exit + + !---------------------------------------------------------------------- + ! Update Jacobian + !---------------------------------------------------------------------- + + ! If number of iterations or steps until Jacobian is to be updated + ! is zero or less, then update the Jacobian. Note: CalcJacobian + ! resets these counters. + if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0)) then + + ! Calculate Jacobians for TC modules + call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_PRED, & + EM_JacobianPContState + EM_JacobianPInput, & + Turbine, ErrStat2, ErrMsg2, & + dYdx=m%dYdx, dXdx=m%dXdx, dYdu=m%dYdu, dXdu=m%dXdu); if (Failed()) return + + ! Calculate the Jacobian + call CalcJacobian(p, m, ErrStat2, ErrMsg2); if (Failed()) return + end if + + !---------------------------------------------------------------------- + ! Formulate right hand side (X_2^tight, U^tight, U^Option1) + !---------------------------------------------------------------------- + + ! Calculate continuous state derivatives for tight coupling modules + call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_PRED, & + EM_CalcContStateDeriv, Turbine, ErrStat2, ErrMsg2, & + dxdt=m%dxdt); if (Failed()) return + + ! Option 1 transfer outputs to inputs + call FAST_EvalModules(t_initial, n_t_global, p%iModOpt1, ModData, STATE_PRED, & + EM_InputSolve, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + ! Get all updated inputs and store in temporary input variable + call TransferFromModules(p%iModOpt1, ModData, STATE_PRED, Turbine, u=m%u_tmp) + + ! Calculate difference between predicted and actual acceleration and add to RHS + m%XB(p%iJX2, 1) = m%qn(:, COL_A) - m%dxdt(p%iX2Tight) + + ! Calculate difference in input/output and add to RHS + m%XB(p%iJT, 1) = m%un(p%iUTight) - m%u_tmp(p%iUTight) + + ! If Option 1 inputs, calc difference and add to RHS + if (size(p%iJ1) > 0) m%XB(p%iJ1, 1) = m%un(p%iUOpt1) - m%u_tmp(p%iUOpt1) + + ! Apply conditioning factor to loads in RHS + m%XB(p%iJL, 1) = m%XB(p%iJL, 1)/p%Scale_UJac + + !---------------------------------------------------------------------- + ! Solve for state and input perturbations + !---------------------------------------------------------------------- + + ! Solve Jacobian and RHS + call LAPACK_getrs('N', size(m%Jac, 1), m%Jac, m%IPIV, m%XB, ErrStat2, ErrMsg2); if (Failed()) return + + ! Remove conditioning + m%XB(p%iJL, 1) = m%XB(p%iJL, 1)*p%Scale_UJac + + !---------------------------------------------------------------------- + ! Check perturbations for convergence and exit if below tolerance + !---------------------------------------------------------------------- + + delta_norm = TwoNorm(m%XB(:, 1)) + if (delta_norm < p%ConvTol) exit + + !---------------------------------------------------------------------- + ! Update State for Tight Coupling modules + !---------------------------------------------------------------------- + + ! Update delta state matrix + m%dq(:, COL_D) = m%dq(:, COL_D) - p%C(3)*m%XB(p%iJX2, 1) + m%dq(:, COL_V) = m%dq(:, COL_V) - p%C(2)*m%XB(p%iJX2, 1) + m%dq(:, COL_A) = m%dq(:, COL_A) - m%XB(p%iJX2, 1) + m%dq(:, COL_AA) = m%dq(:, COL_AA) - p%C(1)*m%XB(p%iJX2, 1) + + ! Transfer change in q state matrix to change in x array + call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) + + ! Add delta to x array to get new states (respect variable fields) + call AddDeltaToStates(ModData, p%iModTC, m%x, m%dx, m%xn) + + ! Calculate new state matrix as sum of previous state and deltas + m%qn = m%q + m%dq + + ! Update new state matrix with new state array values + call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + + ! Transfer new state to modules + call TransferToModules(p%iModTC, ModData, STATE_PRED, Turbine, x=m%xn) + + !---------------------------------------------------------------------- + ! Update inputs for Tight Coupling and Option 1 modules + !---------------------------------------------------------------------- + + ! Update change in inputs + m%du(p%iUTight) = m%du(p%iUTight) - m%XB(p%iJT, 1) + m%du(p%iUOpt1) = m%du(p%iUOpt1) - m%XB(p%iJ1, 1) + + ! Apply deltas to inputs, update modules + call AddDeltaToInputs(ModData, p%iModOpt1, m%u, m%du, m%un) + call TransferToModules(p%iModOpt1, ModData, STATE_PRED, Turbine, u=m%un) + + end do + + m%u = m%un + iterCorr = iterCorr + 1 + + end do + + !---------------------------------------------------------------------------- + ! Update for next step + !---------------------------------------------------------------------------- + + ! Copy the final predicted states from step t_global_next to actual states for that step + call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_PRED, & + EM_SavePredStates, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + ! Save new state + m%x = m%xn + + ! Update the global time + Turbine%m_FAST%t_global = t_global_next + + !---------------------------------------------------------------------------- + ! Write output to file + !---------------------------------------------------------------------------- + + call WriteOutputToFile(n_t_global_next, t_global_next, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------- + + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global_next, Turbine%p_FAST%n_SttsTime) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine CalcJacobian(p, m, ErrStat, ErrMsg) + + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(inOUT) :: m !< Misc variables + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'CalcJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Group (1,1) + m%Jac(p%iJX2, p%iJX2) = -p%C(2)*m%dXdx(p%iX2Tight, p%iX2Tight) - & + p%C(3)*m%dXdx(p%iX2Tight, p%iX1Tight) + do i = 1, size(p%iJX2) + m%Jac(i, i) = m%Jac(i, i) + 1.0_R8Ki + end do + + ! Group (2,1) + m%Jac(p%iJT, p%iJX2) = p%C(2)*matmul(m%dUdy(p%iUTight, p%iyTight), & + m%dYdx(p%iyTight, p%iX2Tight)) + & + p%C(3)*matmul(m%dUdy(p%iUTight, p%iyTight), & + m%dYdx(p%iyTight, p%iX1Tight)) + + ! Group (1,2) + m%Jac(p%iJX2, p%iJT) = -m%dXdu(p%iX2Tight, p%iUTight) + + ! Group (2,2) + m%Jac(p%iJT, p%iJT) = m%dUdu(p%iUTight, p%iUTight) + & + matmul(m%dUdy(p%iUTight, p%iyTight), & + m%dYdu(p%iyTight, p%iUTight)) + + ! If modules in option 1 + if (size(p%iJ1) > 0) then + + ! Group (3,2) + m%Jac(p%iJ1, p%iJT) = m%dUdu(p%iUOpt1, p%iUTight) + & + matmul(m%dUdy(p%iUOpt1, p%iyTight), & + m%dYdu(p%iyTight, p%iUTight)) + ! Group (2,3) + m%Jac(p%iJT, p%iJ1) = m%dUdu(p%iUTight, p%iUOpt1) + & + matmul(m%dUdy(p%iUTight, p%iyOpt1), & + m%dYdu(p%iyOpt1, p%iUOpt1)) + ! Group (3,3) + m%Jac(p%iJ1, p%iJ1) = m%dUdu(p%iUOpt1, p%iUOpt1) + & + matmul(m%dUdy(p%iUOpt1, p%iyOpt1), & + m%dYdu(p%iyOpt1, p%iUOpt1)) + end if + + ! Condition jacobian matrix before factoring + m%Jac(p%iJL, :) = m%Jac(p%iJL, :)/p%Scale_UJac + m%Jac(:, p%iJL) = m%Jac(:, p%iJL)*p%Scale_UJac + + ! Factor jacobian matrix + call LAPACK_getrf(size(m%Jac, 1), size(m%Jac, 1), m%Jac, m%IPIV, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Reset Jacobian update countdown values + m%IterUntilUJac = p%NIter_UJac + m%StepsUntilUJac = p%NStep_UJac + +end subroutine + +subroutine AddDeltaToStates(ModData, ModOrder, x, dx, xn) + use ModVar + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate + real(R8Ki), intent(in) :: dx(:) + real(R8Ki), intent(in) :: x(:) + real(R8Ki), intent(out) :: xn(:) + integer(IntKi) :: iMod, iIns + integer(IntKi) :: i, j, k, iGbl(3) + + ! Loop through modules in order + do i = 1, size(ModOrder) + + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + + ! Loop through variables + do j = 1, size(ModData(iMod)%Vars%x) + + ! Select based on field type + select case (ModData(iMod)%Vars%x(j)%Field) + case (VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) + ! Add delta x to x + xn(ModData(iMod)%Vars%x(j)%iGbl) = x(ModData(iMod)%Vars%x(j)%iGbl) + dx(ModData(iMod)%Vars%x(j)%iGbl) + case (VF_AngularDisp) + ! Add delta x to x and limit to between -2pi and 2pi + ! xn(ModData(iMod)%Vars%x(j)%iGbl) = mod(x(ModData(iMod)%Vars%x(j)%iGbl) + dx(ModData(iMod)%Vars%x(j)%iGbl), TwoPi_R8) + xn(ModData(iMod)%Vars%x(j)%iGbl) = x(ModData(iMod)%Vars%x(j)%iGbl) + dx(ModData(iMod)%Vars%x(j)%iGbl) + case (VF_Orientation) + ! Compose WM components + do k = 1, size(ModData(iMod)%Vars%x(j)%iGbl), 3 + iGbl = ModData(iMod)%Vars%x(j)%iGbl(k:k + 2) + xn(iGbl) = wm_compose(dx(iGbl), x(iGbl)) + end do + end select + + end do + end do +end subroutine + +subroutine AddDeltaToInputs(ModData, ModOrder, u, du, un) + use ModVar + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate + real(R8Ki), intent(in) :: du(:) + real(R8Ki), intent(in) :: u(:) + real(R8Ki), intent(out) :: un(:) + integer(IntKi) :: iMod, iIns + integer(IntKi) :: i, j, k, iGbl(3) + + ! Loop through modules in order + do i = 1, size(ModOrder) + + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + + ! Loop through variables + do j = 1, size(ModData(iMod)%Vars%u) + + ! Select based on field type + select case (ModData(iMod)%Vars%u(j)%Field) + case (VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) + ! Add delta u to u + un(ModData(iMod)%Vars%u(j)%iGbl) = u(ModData(iMod)%Vars%u(j)%iGbl) + du(ModData(iMod)%Vars%u(j)%iGbl) + case (VF_AngularDisp) + ! Add delta u to u and limit to between -2pi and 2pi + ! un(ModData(iMod)%Vars%u(j)%iGbl) = mod(u(ModData(iMod)%Vars%u(j)%iGbl) + du(ModData(iMod)%Vars%u(j)%iGbl), TwoPi_R8) + un(ModData(iMod)%Vars%u(j)%iGbl) = u(ModData(iMod)%Vars%u(j)%iGbl) + du(ModData(iMod)%Vars%u(j)%iGbl) + case (VF_Orientation) + ! Compose WM components + do k = 1, size(ModData(iMod)%Vars%u(j)%iGbl), 3 + iGbl = ModData(iMod)%Vars%u(j)%iGbl(k:k + 2) + un(iGbl) = wm_compose(du(iGbl), u(iGbl)) + end do + end select + + end do + end do +end subroutine + +subroutine TransferFromModules(ModOrder, ModData, this_state, T, x, u, y) + integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), allocatable, optional, intent(inout) :: x(:), u(:), y(:) + integer(IntKi) :: i, iMod, iIns + + if (present(x)) then + do i = 1, size(ModOrder) + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + select case (ModData(iMod)%ID) + case (Module_ED) + call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) + x(T%ED%p%Vars%ixg) = T%ED%m%Vals%x + case (Module_BD) + ! BD_PackStateValues(BD%p(iIns), BD%x(this_state, iIns), BD%m(iIns)%Vals%x) + ! x(BD%p%Vars%ix) = BD%m%Vals%x + case (Module_SD) + ! call SD_PackStateValues(SD%p, SD%x(this_state), SD%m%Vals%x) + ! x(SD%p%Vars%ix) = SD%m%Vals%x + end select + end do + end if + + if (present(u)) then + do i = 1, size(ModOrder) + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + select case (ModData(iMod)%ID) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + u(T%ED%p%Vars%iug) = T%ED%m%Vals%u + case (Module_BD) + ! BD_PackInputValues(BD%p(iIns), BD%Input(iIns), BD%m(iIns)%Vals%u) + ! u(BD%p%Vars%iu) = BD%m%Vals%u + case (Module_SD) + ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) + ! u(SD%p%Vars%iu) = SD%m%Vals%u + end select + end do + end if + + if (present(y)) then + do i = 1, size(ModOrder) + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + select case (ModData(iMod)%ID) + case (Module_ED) + call ED_PackOutputValues(T%ED%p, T%ED%y, T%ED%m%Vals%y) + y(T%ED%p%Vars%iyg) = T%ED%m%Vals%y + case (Module_BD) + ! BD_PackOutputValues(BD%p(iIns), BD%y(iIns), BD%m(iIns)%Vals%y) + ! y(BD%p%Vars%iy) = BD%m%Vals%y + case (Module_SD) + ! call SD_PackOutputValues(SD%p, SD%y, SD%m%Vals%y) + ! y(SD%p%Vars%iy) = SD%m%Vals%y + end select + end do + end if + + ! if (present(dxdt)) then + ! do i = 1, size(ModOrder) + ! iMod = ModOrder(i) + ! iIns = ModData(iMod)%Instance + ! select case (ModData(iMod)%ID) + ! case (Module_ED) + ! call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) + ! dxdt(T%ED%p%Vars%ixg) = T%ED%m%Vals%dxdt + ! case (Module_BD) + ! ! BD_PackStateValues(BD%p(iIns), BD%dxdt(iIns), BD%m(iIns)%Vals%dxdt) + ! ! dxdt(BD%p%Vars%ix) = BD%m%Vals%dxdt + ! case (Module_SD) + ! ! call SD_PackStateValues(SD%p, SD%dxdt, SD%m%Vals%dxdt) + ! ! dxdt(SD%p%Vars%ix) = SD%m%Vals%dxdt + ! end select + ! end do + ! end if + + ! if (present(dYdx)) then + ! do i = 1, size(ModOrder) + ! iMod = ModOrder(i) + ! iIns = ModData(iMod)%Instance + ! select case (ModData(iMod)%ID) + ! case (Module_ED) + ! dYdx(T%ED%p%Vars%iyg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dYdx + ! case (Module_BD) + ! ! dYdx(BD%p%Vars%iy, BD%p%Vars%ix) = BD%m%Vals%dYdx + ! case (Module_SD) + ! ! dYdx(SD%p%Vars%iy, SD%p%Vars%ix) = SD%m%Vals%dYdx + ! end select + ! end do + ! end if + + ! if (present(dXdx)) then + ! do i = 1, size(ModOrder) + ! iMod = ModOrder(i) + ! iIns = ModData(iMod)%Instance + ! select case (ModData(iMod)%ID) + ! case (Module_ED) + ! dXdx(T%ED%p%Vars%ixg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dXdx + ! case (Module_BD) + ! ! dXdx(BD%p%Vars%ix, BD%p%Vars%ix) = BD%m%Vals%dXdx + ! case (Module_SD) + ! ! dXdx(SD%p%Vars%ix, SD%p%Vars%ix) = SD%m%Vals%dXdx + ! end select + ! end do + ! end if + + ! if (present(dYdu)) then + ! do i = 1, size(ModOrder) + ! iMod = ModOrder(i) + ! iIns = ModData(iMod)%Instance + ! select case (ModData(iMod)%ID) + ! case (Module_ED) + ! dYdu(T%ED%p%Vars%iyg, T%ED%p%Vars%iug) = T%ED%m%Vals%dYdu + ! case (Module_BD) + ! ! dYdu(BD%p%Vars%iy, BD%p%Vars%iu) = BD%m%Vals%dYdu + ! case (Module_SD) + ! ! dYdu(SD%p%Vars%iy, SD%p%Vars%iu) = SD%m%Vals%dYdu + ! end select + ! end do + ! end if + + ! if (present(dXdu)) then + ! do i = 1, size(ModOrder) + ! iMod = ModOrder(i) + ! iIns = ModData(iMod)%Instance + ! select case (ModData(iMod)%ID) + ! case (Module_ED) + ! dXdu(T%ED%p%Vars%ixg, T%ED%p%Vars%iug) = T%ED%m%Vals%dXdu + ! case (Module_BD) + ! ! dXdu(BD%p%Vars%ix, BD%p%Vars%iu) = BD%m%Vals%dXdu + ! case (Module_SD) + ! ! dXdu(SD%p%Vars%ix, SD%p%Vars%iu) = SD%m%Vals%dXdu + ! end select + ! end do + ! end if + +end subroutine + +subroutine TransferToModules(ModOrder, ModData, this_state, T, x, u) + integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), allocatable, optional, intent(inout) :: x(:), u(:) + integer(IntKi) :: i, iMod, iIns + + if (present(x)) then + do i = 1, size(ModOrder) + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + select case (ModData(iMod)%ID) + case (Module_ED) + call ED_UnpackStateValues(T%ED%p, x(T%ED%p%Vars%ixg), T%ED%x(this_state)) + case (Module_BD) + ! BD_UnpackStateValues(BD%p(iIns), x(BD%p%Vars%ix), BD%x(this_state, iIns)) + case (Module_SD) + ! call SD_UnpackStateValues(SD%p, x(SD%p%Vars%ix), SD%x(this_state)) + end select + end do + end if + + if (present(u)) then + do i = 1, size(ModOrder) + iMod = ModOrder(i) + iIns = ModData(iMod)%Instance + select case (ModData(iMod)%ID) + case (Module_ED) + call ED_UnpackInputValues(T%ED%p, u(T%ED%p%Vars%iug), T%ED%Input(1)) + case (Module_BD) + ! BD_UnpackInputValues(BD%p(iIns), u(BD%p%Vars%iu), BD%Input(1, iIns)) + case (Module_SD) + ! call SD_UnpackInputValues(SD%p, u(SD%p%Vars%iu), SD%Input(1)) + end select + end do + end if + +end subroutine + +subroutine WriteOutputToFile(n_t_global, t_global, T, ErrStat, ErrMsg) + + integer(IntKi), intent(in) :: n_t_global !< Current global time step + real(DbKi), intent(in) :: t_global !< Current global time + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WriteOutputToFile' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! If output requested for this step, time-series channel data to glue-code output file + if (T%y_FAST%WriteThisStep) then + ! call WrOutputLine(t_global, T%p_FAST, T%y_FAST, T%IfW%y%WriteOutput, & + ! T%OpFM%y%WriteOutput, T%ED%y%WriteOutput, & + ! T%AD%y, T%SrvD%y%WriteOutput, T%SeaSt%y%WriteOutput, & + ! T%HD%y%WriteOutput, T%SD%y%WriteOutput, T%ExtPtfm%y%WriteOutput, & + ! T%MAP%y%WriteOutput, T%FEAM%y%WriteOutput, T%MD%y%WriteOutput, & + ! T%Orca%y%WriteOutput, T%IceF%y%WriteOutput, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + +end subroutine + +end module From b1ba73e6aec2f29b6199b2b824ed5addf0d1e2f8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 21 Jul 2023 21:49:27 +0000 Subject: [PATCH 07/61] Default to TIGHT_COUPLING=OFF --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 510c31c977..b45ef3df1f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -39,7 +39,7 @@ option(VARIABLE_TRACKING "Enables variable tracking for better runtime debugging option(GENERATE_TYPES "Use the openfast-regsitry to autogenerate types modules" off) option(BUILD_SHARED_LIBS "Enable building shared libraries" off) option(DOUBLE_PRECISION "Treat REAL as double precision" on) -option(TIGHT_COUPLING "Enable tight couping solver" on) +option(TIGHT_COUPLING "Enable tight couping solver" off) option(USE_DLL_INTERFACE "Enable runtime loading of dynamic libraries" on) option(FPE_TRAP_ENABLED "Enable FPE trap in compiler options" off) option(ORCA_DLL_LOAD "Enable OrcaFlex Library Load" on) From 6f99479f40fcd6b6c0d10be28de9f8ce0d4da225 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 16 Aug 2023 00:44:07 +0000 Subject: [PATCH 08/61] NWTC Library updates for tight coupling --- modules/nwtc-library/CMakeLists.txt | 2 +- modules/nwtc-library/src/ModVar.f90 | 661 ++++++++++++------ .../nwtc-library/src/NWTC_Library_Types.f90 | 483 +++++++------ .../src/Registry_NWTC_Library.txt | 20 +- .../src/Registry_NWTC_Library_base.txt | 20 +- 5 files changed, 746 insertions(+), 440 deletions(-) diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 1c30b63202..994765fd44 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -15,7 +15,6 @@ # if (GENERATE_TYPES) - generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS src/Registry_NWTC_Library_mesh.txt @@ -23,6 +22,7 @@ if (GENERATE_TYPES) file(READ src/Registry_NWTC_Library_base.txt BASE_CONTENTS) file(READ src/Registry_NWTC_Library_mesh.txt MESH_CONTENTS) file(WRITE src/Registry_NWTC_Library.txt "${BASE_CONTENTS}\n${MESH_CONTENTS}") + generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) endif() #------------------------------------------------------------------------------- diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index a62e41470a..2a8f956679 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -33,57 +33,62 @@ module ModVar integer(IntKi), parameter :: & LoadFields(*) = [VF_Force, VF_Moment], & TransFields(*) = [VF_TransDisp, VF_TransVel, VF_TransAcc], & - AngularFields(*) = [VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & - MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc] - -public :: MV_InitVars, MV_LinkOutputInput, MV_VarIndex, MV_PackMesh, MV_UnpackMesh -public :: MV_ComputeCentralDiff, MV_Perturb -public :: MV_AddVar, MV_AddMeshVar, MV_AddModule -public :: LoadFields, MotionFields, TransFields, AngularFields -public :: wm_to_dcm, MV_CollectGlobalIndices, wm_compose + AngularFields(*) = [VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & + MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & + MeshFields(*) = [LoadFields, MotionFields] + +interface MV_PackVar + module procedure MV_PackVarR4, MV_PackVarR4Ary + module procedure MV_PackVarR8, MV_PackVarR8Ary +end interface + +interface MV_UnpackVar + module procedure MV_UnpackVarR4, MV_UnpackVarR4Ary + module procedure MV_UnpackVarR8, MV_UnpackVarR8Ary +end interface + +public :: MV_InitVarsVals, MV_LinkOutputInput, MV_VarIndex, MV_PackMesh, MV_UnpackMesh, MV_PackVar, MV_UnpackVar +public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff +public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags +public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields +public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_from_xyz, wm_inv +public :: MV_FieldString contains -subroutine MV_Perturb(Var, iLin, PerturbSign, BaseArr, PerturbArr, iPerturb) - type(ModVarType), intent(in) :: Var - integer(IntKi), intent(in) :: iLin - integer(IntKi), intent(in) :: PerturbSign - real(R8Ki), intent(in) :: BaseArr(:) - real(R8Ki), intent(inout) :: PerturbArr(:) - integer(IntKi), intent(out) :: iPerturb - real(R8Ki) :: Perturb - real(R8Ki) :: WM(3), WMp(3) - integer(IntKi) :: i, j, iLocArr(3) - - ! Copy base array to perturbed array - PerturbArr = BaseArr - - ! Get variable perturbation and combine with sign - Perturb = Var%Perturb*real(PerturbSign, R8Ki) - - ! Perturbation index within array - iPerturb = Var%iLoc(iLin) - - ! If variable is in a mesh and field is orientation - if (Var%Field == VF_Orientation) then - j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - i = iLin - j ! index of start of WM parameters (3) - iLocArr = Var%iLoc(i:i + 2) ! array index vector - WMp = 0.0_R8Ki ! Init WM perturbation to zero - WMp(j + 1) = 4*tan(Perturb/4.0_R8Ki) ! WM perturbation around X,Y,Z axis - WM = PerturbArr(iLocArr) ! Current WM parameters value - PerturbArr(iLocArr) = wm_compose(WM, WMp) ! Compose value and perturbation - else - PerturbArr(Var%iLoc(iLin)) = PerturbArr(Var%iLoc(iLin)) + Perturb - end if - -end subroutine +function MV_FieldString(Field) result(str) + integer(IntKi), intent(in) :: Field + character(16) :: str + select case (Field) + case (VF_AngularAcc) + str = "VF_AngularAcc" + case (VF_AngularDisp) + str = "VF_AngularDisp" + case (VF_AngularVel) + str = "VF_AngularVel" + case (VF_Force) + str = "VF_Force" + case (VF_Moment) + str = "VF_Moment" + case (VF_Orientation) + str = "VF_Orientation" + case (VF_TransAcc) + str = "VF_TransAcc" + case (VF_TransDisp) + str = "VF_TransDisp" + case (VF_TransVel) + str = "VF_TransVel" + case default + str = "Unknown" + end select +end function -subroutine MV_InitVars(Vars, Vals, ErrStat, ErrMsg) - type(ModVarsType), intent(inout) :: Vars - type(ModValsType), pointer, intent(inout) :: Vals - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg +subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: Vars + type(ModValsType), intent(inout) :: Vals + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg character(*), parameter :: RoutineName = 'MV_InitMod' integer(IntKi) :: ErrStat2 @@ -97,19 +102,19 @@ subroutine MV_InitVars(Vars, Vals, ErrStat, ErrMsg) ! Initialize state variables StartIndex = 1 do i = 1, size(Vars%x) - call ModVarType_Init(Vars%x(i), StartIndex, ErrStat2, ErrMsg2); if (Failed()) return + call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize input variables StartIndex = 1 do i = 1, size(Vars%u) - call ModVarType_Init(Vars%u(i), StartIndex, ErrStat2, ErrMsg2); if (Failed()) return + call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize output variables StartIndex = 1 do i = 1, size(Vars%y) - call ModVarType_Init(Vars%y(i), StartIndex, ErrStat2, ErrMsg2); if (Failed()) return + call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Calculate number of variables in group (exclude non linearization vars) @@ -117,13 +122,6 @@ subroutine MV_InitVars(Vars, Vals, ErrStat, ErrMsg) Vars%Nu = sum(Vars%u%Size, iand(Vars%u%Flags, VF_NoLin) == 0) Vars%Ny = sum(Vars%y%Size, iand(Vars%y%Flags, VF_NoLin) == 0) - call AllocAry(Vars%ixg, Vars%Nx, "Vars%ixg", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vars%iug, Vars%Nu, "Vars%iug", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(Vars%iyg, Vars%Ny, "Vars%iyg", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate Vals derived type - allocate (Vals, stat=ErrStat2); if (FailedAlloc()) return - ! Allocate state, input, and output values call AllocAry(Vals%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(Vals%dxdt, Vars%Nx, "Vals%dxdt", ErrStat2, ErrMsg2); if (Failed()) return @@ -154,24 +152,16 @@ function FailedAlloc() end subroutine -subroutine MV_CollectGlobalIndices(VarArr, iGbl) - type(ModVarType), intent(in) :: VarArr(:) - integer(IntKi), intent(out) :: iGbl(:) - integer(IntKi) :: i - do i = 1, size(VarArr) - iGbl(VarArr(i)%iLoc) = VarArr(i)%iGbl - end do -end subroutine - elemental function IsMesh(Var) result(r) type(ModVarType), intent(in) :: Var logical :: r r = iand(Var%Flags, VF_Mesh) > 0 end function -subroutine ModVarType_Init(Var, Index, ErrStat, ErrMsg) - type(ModVarType), intent(inout) :: Var +subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: Var integer(IntKi), intent(inout) :: Index + logical, intent(in) :: Linearize integer(IntKi), intent(out) :: ErrStat character(ErrMsgLen), intent(out) :: ErrMsg @@ -208,33 +198,37 @@ subroutine ModVarType_Init(Var, Index, ErrStat, ErrMsg) Var%NumLin = Var%Nodes*3 Var%Size = Var%Nodes*3 - ! Set unit description for line mesh - UnitDesc = '' - if (iand(Var%Flags, VF_Line) > 0) UnitDesc = "/m" - - ! Switch based on field number - select case (Var%Field) - case (VF_Force) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, nNodes)] - case (VF_Moment) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, nNodes)] - case (VF_TransDisp) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, nNodes)] - case (VF_Orientation) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, nNodes)] - case (VF_TransVel) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, nNodes)] - case (VF_AngularVel) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, nNodes)] - case (VF_TransAcc) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, nNodes)] - case (VF_AngularAcc) - Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, nNodes)] - case default - call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) - return - end select + ! If linearization requested + if (Linearize) then + + ! Set unit description for line mesh + UnitDesc = '' + if (iand(Var%Flags, VF_Line) > 0) UnitDesc = "/m" + + ! Switch based on field number + select case (Var%Field) + case (VF_Force) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_Moment) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_TransDisp) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, nNodes)] + case (VF_Orientation) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, nNodes)] + case (VF_TransVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, nNodes)] + case (VF_AngularVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, nNodes)] + case (VF_TransAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, nNodes)] + case (VF_AngularAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, nNodes)] + case default + call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) + return + end select + end if end if !---------------------------------------------------------------------------- @@ -246,7 +240,7 @@ subroutine ModVarType_Init(Var, Index, ErrStat, ErrMsg) ! Number of linearization values is zero if NoLin flag is set Var%NumLin = 0 - else + else if (Linearize) then ! If insufficient linearization names, return error if (size(Var%LinNames) < Var%NumLin) then @@ -263,40 +257,9 @@ subroutine ModVarType_Init(Var, Index, ErrStat, ErrMsg) call AllocAry(Var%iLoc, Var%Size, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return Var%iLoc = [(index + i, i=0, Var%Size - 1)] - ! Initialize global index - call AllocAry(Var%iGbl, Var%Size, "Var%iGbl", ErrStat2, ErrMsg2); if (Failed()) return - Var%iGbl = 0 - ! Update index based on variable size index = index + Var%Size - !---------------------------------------------------------------------------- - ! Derivative Order - !---------------------------------------------------------------------------- - - select case (Var%Field) - case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position - Var%DerivOrder = 0 - case (VF_TransVel, VF_AngularVel) ! Velocity - Var%DerivOrder = 1 - case (VF_TransAcc, VF_AngularAcc) ! Acceleration - Var%DerivOrder = 2 - case default - Var%DerivOrder = -1 - end select - - !---------------------------------------------------------------------------- - ! Module Index - !---------------------------------------------------------------------------- - - ! If module index has been allocated and size does not mach variable size, return error - if (allocated(Var%iUsr)) then - if (size(Var%iUsr) < Var%Size) then - call SetErrStat(ErrID_Fatal, "insufficient iMod given for "//Var%Name, ErrStat, ErrMsg, RoutineName) - return - end if - end if - contains function Failed() logical :: Failed @@ -305,105 +268,237 @@ function Failed() end function end subroutine -subroutine MV_PackMesh(VarArr, Mesh, arr) - type(ModVarType), intent(in) :: VarArr(:) +!------------------------------------------------------------------------------- +! Functions for packing and unpacking data by variable +!------------------------------------------------------------------------------- + +subroutine MV_PackVarR4(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc(1)) = real(Val, R8Ki) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR8(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc(1)) = Val + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR4Ary(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Val(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc) = real(pack(Val, .true.), R4Ki) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR8Ary(VarAry, iVar, Vals, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Vals(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc) = pack(Vals, .true.) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Val + Val = Ary(VarAry(iVar)%iLoc(1)) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR4Ary(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals = Ary(VarAry(iVar)%iLoc) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR8(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals + Vals = Ary(VarAry(iVar)%iLoc(1)) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR8Ary(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals = Ary(VarAry(iVar)%iLoc) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar type(MeshType), intent(in) :: Mesh - real(R8Ki), intent(inout) :: arr(:) - integer(IntKi) :: i, j - do i = 1, size(VarArr) - select case (VarArr(i)%Field) + real(R8Ki), intent(inout) :: Values(:) + character(VarNameLen) :: MeshName + integer(IntKi) :: j + MeshName = VarAry(iVar)%Name + do while (VarAry(iVar)%Name == MeshName) + select case (VarAry(iVar)%Field) case (VF_Force) - arr(VarArr(i)%iLoc) = pack(Mesh%Force, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Force, .true.) case (VF_Moment) - arr(VarArr(i)%iLoc) = pack(Mesh%Moment, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Moment, .true.) case (VF_TransDisp) - arr(VarArr(i)%iLoc) = pack(Mesh%TranslationDisp, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationDisp, .true.) case (VF_Orientation) - do j = 1, VarArr(i)%Nodes - arr(VarArr(i)%iLoc(3*(j - 1) + 1:3*j)) = wm_from_dcm(Mesh%Orientation(:, :, j)) + do j = 1, VarAry(iVar)%Nodes + Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j)) = wm_from_dcm(Mesh%Orientation(:, :, j)) end do case (VF_TransVel) - arr(VarArr(i)%iLoc) = pack(Mesh%TranslationVel, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationVel, .true.) case (VF_AngularVel) - arr(VarArr(i)%iLoc) = pack(Mesh%RotationVel, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationVel, .true.) case (VF_TransAcc) - arr(VarArr(i)%iLoc) = pack(Mesh%TranslationAcc, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationAcc, .true.) case (VF_AngularAcc) - arr(VarArr(i)%iLoc) = pack(Mesh%RotationAcc, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationAcc, .true.) case (VF_Scalar) - arr(VarArr(i)%iLoc) = pack(Mesh%Scalars, .true.) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Scalars, .true.) end select + iVar = iVar + 1 + if (iVar > size(VarAry)) exit end do end subroutine -subroutine MV_UnpackMesh(VarArr, arr, Mesh) - type(ModVarType), intent(in) :: VarArr(:) - real(R8Ki), intent(in) :: arr(:) +subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Values(:) type(MeshType), intent(inout) :: Mesh - integer(IntKi) :: i, j - do i = 1, size(VarArr) - select case (VarArr(i)%Field) + character(VarNameLen) :: MeshName + integer(IntKi) :: j + MeshName = VarAry(iVar)%Name + do while (VarAry(iVar)%Name == MeshName) + select case (VarAry(iVar)%Field) case (VF_Force) - Mesh%Force = reshape(arr(VarArr(i)%iLoc), shape(Mesh%Force)) + Mesh%Force = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Force)) case (VF_Moment) - Mesh%Moment = reshape(arr(VarArr(i)%iLoc), shape(Mesh%Moment)) + Mesh%Moment = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Moment)) case (VF_TransDisp) - Mesh%TranslationDisp = reshape(arr(VarArr(i)%iLoc), shape(Mesh%TranslationDisp)) + Mesh%TranslationDisp = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationDisp)) case (VF_Orientation) - do j = 1, VarArr(i)%Nodes - Mesh%Orientation(:, :, j) = wm_to_dcm(arr(VarArr(i)%iLoc(3*(j - 1) + 1:3*j))) + do j = 1, VarAry(iVar)%Nodes + Mesh%Orientation(:, :, j) = wm_to_dcm(Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j))) end do case (VF_TransVel) - Mesh%TranslationVel = reshape(arr(VarArr(i)%iLoc), shape(Mesh%TranslationVel)) + Mesh%TranslationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationVel)) case (VF_AngularVel) - Mesh%RotationVel = reshape(arr(VarArr(i)%iLoc), shape(Mesh%RotationVel)) + Mesh%RotationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationVel)) case (VF_TransAcc) - Mesh%TranslationAcc = reshape(arr(VarArr(i)%iLoc), shape(Mesh%TranslationAcc)) + Mesh%TranslationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationAcc)) case (VF_AngularAcc) - Mesh%RotationAcc = reshape(arr(VarArr(i)%iLoc), shape(Mesh%RotationAcc)) + Mesh%RotationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationAcc)) case (VF_Scalar) - Mesh%Scalars = reshape(arr(VarArr(i)%iLoc), shape(Mesh%Scalars)) + Mesh%Scalars = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Scalars)) end select + iVar = iVar + 1 + if (iVar > size(VarAry)) exit end do end subroutine -subroutine MV_ComputeCentralDiff(VarArr, Delta, PosArr, NegArr, DerivArr) - type(ModVarType), intent(in) :: VarArr(:) ! Array of variables - real(R8Ki), intent(in) :: Delta ! Positive perturbation value - real(R8Ki), intent(in) :: PosArr(:) ! Positive perturbation result array - real(R8Ki), intent(in) :: NegArr(:) ! Negative perturbation result array - real(R8Ki), intent(inout) :: DerivArr(:) ! Array containing derivative - integer(IntKi) :: i, j, rloc(3) - real(R8Ki) :: WMp(3), WMn(3) +subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: iLin + integer(IntKi), intent(in) :: PerturbSign + real(R8Ki), intent(in) :: BaseAry(:) + real(R8Ki), intent(inout) :: PerturbAry(:) + integer(IntKi), intent(out) :: iPerturb + real(R8Ki) :: Perturb + real(R8Ki) :: WM(3), WMp(3) + integer(IntKi) :: i, j, iLoc(3) - ! Compute difference between all values - DerivArr = PosArr - NegArr + ! Copy base array to perturbed array + PerturbAry = BaseAry + + ! Get variable perturbation and combine with sign + Perturb = Var%Perturb*real(PerturbSign, R8Ki) + + ! Perturbation index within array + iPerturb = Var%iLoc(iLin) + + ! If variable field is orientation, perturbation is in WM parameters + if (Var%Field == VF_Orientation) then + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = iLin - j ! index of start of WM parameters (3) + iLoc = Var%iLoc(i:i + 2) ! array index vector + WMp = 0.0_R8Ki ! Init WM perturbation to zero + WMp(j + 1) = 4.0_R8Ki*tan(Perturb/4.0_R8Ki) ! WM perturbation around X,Y,Z axis + ! WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + WM = PerturbAry(iLoc) ! Current WM parameters value + PerturbAry(iLoc) = wm_compose(WM, WMp) ! Compose value and perturbation + else + PerturbAry(Var%iLoc(iLin)) = PerturbAry(Var%iLoc(iLin)) + Perturb + end if +end subroutine + +subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: PosAry(:) ! Positive result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative result array + real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference + integer(IntKi) :: i, j, ind(3) + real(R8Ki) :: DeltaWM(3) + ! Loop through variables - do i = 1, size(VarArr) + do i = 1, size(VarAry) - ! If variable is mesh rotation - if (VarArr(i)%Field == VF_Orientation) then + ! If variable field is orientation + if (VarAry(i)%Field == VF_Orientation) then ! Loop through nodes - do j = 1, VarArr(i)%Nodes + do j = 1, VarAry(i)%Nodes ! Get vector of indicies of WM rotation parameters in array - rloc = VarArr(i)%iLoc(3*(j - 1) + 1:3*j) + ind = VarAry(i)%iLoc(3*(j - 1) + 1:3*j) - ! Get rotation from positive and negative perturbation - WMp = PosArr(rloc) - WMn = NegArr(rloc) + ! Compose WM parameters to go from negative to positive array + DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) - ! Calculate change in rotation and add to array - DerivArr(rloc) = wm_compose(wm_inv(WMn), WMp) - ! arrDelta(rloc) = wm_to_zyx(wm_compose(wm_inv(WMn), WMp)) + ! Calculate change in rotation in XYZ in radians + DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) end do + + else + + ! Subtract negative array from positive array + DiffAry(VarAry(i)%iLoc) = PosAry(VarAry(i)%iLoc) - NegAry(VarAry(i)%iLoc) end if end do +end subroutine + +subroutine MV_ComputeCentralDiff(VarAry, Delta, PosAry, NegAry, DerivAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: Delta ! Positive perturbation value + real(R8Ki), intent(in) :: PosAry(:) ! Positive perturbation result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative perturbation result array + real(R8Ki), intent(inout) :: DerivAry(:) ! Array containing derivative + + ! Compute difference between all values + call MV_ComputeDiff(VarAry, PosAry, NegAry, DerivAry) - ! Divide array by 2*delta - DerivArr = DerivArr/(2.0_R8Ki*Delta) + ! Divide derivative array by twice delta + DerivAry = DerivAry/(2.0_R8Ki*Delta) end subroutine @@ -411,35 +506,91 @@ subroutine MV_ComputeCentralDiff(VarArr, Delta, PosArr, NegArr, DerivArr) ! Functions for adding Variables an Modules !------------------------------------------------------------------------------- -subroutine MV_AddModule(ModArr, ModID, ModAbbr, Instance, DT, Vars, Vals) - type(ModDataType), allocatable, intent(inout) :: ModArr(:) - integer(IntKi), intent(in) :: ModID - character(*), intent(in) :: ModAbbr - integer(IntKi), intent(in) :: Instance - real(R8Ki), intent(in) :: DT - type(ModVarsType), pointer, intent(in) :: Vars - type(ModValsType), pointer, intent(in) :: Vals - type(ModDataType) :: MData - MData = ModDataType(ID=ModID, Abbr=ModAbbr, Instance=Instance, DT=DT, Vars=Vars, Vals=Vals) - if (allocated(ModArr)) then - ModArr = [ModArr, MData] +subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: ModAry(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), pointer, intent(in) :: Vars + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + + ErrStat = ErrID_None + ErrMsg = '' + + ! Populate ModuleDataType derived type + ModData = ModDataType(ID=ModID, Abbr=ModAbbr, Ins=Instance, DT=ModDT, Vars=Vars) + + ! Allocate mapping index with zero length + call AllocAry(ModData%iMapsOpt1, 0, "ModData%iMapsOpt1", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%iMapsOpt2, 0, "ModData%iMapsOpt2", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%iMapsAll, 0, "ModData%iMapsAll", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 else - ModArr = [MData] + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module data to array + !---------------------------------------------------------------------------- + + if (allocated(ModAry)) then + ModAry = [ModAry, ModData] + else + ModAry = [ModData] end if end subroutine -subroutine MV_AddMeshVar(VarArr, Name, Fields, Nodes, Flags, Perturbs, Active) - type(ModVarType), allocatable, intent(inout) :: VarArr(:) +subroutine MV_AddMeshVar(VarAry, Name, Fields, Nodes, Flags, Perturbs, Active) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Fields(:) - integer(IntKi), optional, intent(in) :: Nodes, Flags + integer(IntKi), intent(in) :: Nodes + integer(IntKi), optional, intent(in) :: Flags real(R8Ki), optional, intent(in) :: Perturbs(:) logical, optional, intent(in) :: Active - integer(IntKi) :: i, NodesLocal, FlagsLocal + integer(IntKi) :: i, FlagsLocal logical :: ActiveLocal real(R8Ki), allocatable :: PerturbsLocal(:) - NodesLocal = 1 - if (present(Nodes)) NodesLocal = Nodes FlagsLocal = 0 if (present(Flags)) FlagsLocal = Flags FlagsLocal = ior(FlagsLocal, VF_Mesh) @@ -448,13 +599,13 @@ subroutine MV_AddMeshVar(VarArr, Name, Fields, Nodes, Flags, Perturbs, Active) ActiveLocal = .true. if (present(Active)) ActiveLocal = Active do i = 1, size(Fields) - call MV_AddVar(VarArr, Name, Fields(i), Num=NodesLocal, Flags=FlagsLocal, & + call MV_AddVar(VarAry, Name, Fields(i), Num=Nodes, Flags=FlagsLocal, & Perturb=PerturbsLocal(i), Active=ActiveLocal) end do end subroutine -subroutine MV_AddVar(VarArr, Name, Field, Num, Flags, iUsr, Perturb, LinNames, Active) - type(ModVarType), allocatable, intent(inout) :: VarArr(:) +subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, Perturb, LinNames, Active) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field integer(IntKi), optional, intent(in) :: Num, Flags, iUsr(:) @@ -462,7 +613,7 @@ subroutine MV_AddVar(VarArr, Name, Field, Num, Flags, iUsr, Perturb, LinNames, A logical, optional, intent(in) :: Active character(*), optional, intent(in) :: LinNames(:) integer(IntKi) :: i - type(ModVarType) :: Var + type(ModVarType) :: Var ! If active argument specified and not active, return if (present(Active)) then @@ -484,23 +635,37 @@ subroutine MV_AddVar(VarArr, Name, Field, Num, Flags, iUsr, Perturb, LinNames, A end do end if - if (allocated(VarArr)) then - VarArr = [VarArr, Var] + ! Set Derivative Order + select case (Var%Field) + case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position/displacement + Var%DerivOrder = 0 + case (VF_TransVel, VF_AngularVel) ! Velocity + Var%DerivOrder = 1 + case (VF_TransAcc, VF_AngularAcc) ! Acceleration + Var%DerivOrder = 2 + case default + Var%DerivOrder = -1 + end select + + ! Append Var to VarArray + if (allocated(VarAry)) then + VarAry = [VarAry, Var] else - VarArr = [Var] + VarAry = [Var] end if end subroutine -function MV_VarIndex(VarArr, Name, Field) result(Indx) - type(ModVarType), intent(in) :: VarArr(:) +! Get index of variable in array matching name and field +function MV_VarIndex(VarAry, Name, Field) result(Indx) + type(ModVarType), intent(in) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field integer(IntKi) :: Indx - do Indx = 1, size(VarArr) - if (string_equal_ci(VarArr(Indx)%Name, Name) .and. & - VarArr(Indx)%Field == Field) exit + do Indx = 1, size(VarAry) + if (string_equal_ci(VarAry(Indx)%Name, Name) .and. & + VarAry(Indx)%Field == Field) exit end do - if (Indx > size(VarArr)) Indx = 0 + if (Indx > size(VarAry)) Indx = 0 end function !------------------------------------------------------------------------------- @@ -508,7 +673,7 @@ function MV_VarIndex(VarArr, Name, Field) result(Indx) !------------------------------------------------------------------------------- subroutine MV_LinkOutputInput(OutVars, InpVars, OutName, InpName, Field, ErrStat, ErrMsg) - type(ModVarsType), intent(inout) :: OutVars, InpVars + type(ModVarsType), intent(inout) :: OutVars, InpVars character(*), intent(in) :: OutName, InpName integer(IntKi), intent(in) :: Field integer(IntKi), intent(out) :: ErrStat @@ -547,6 +712,17 @@ subroutine MV_LinkOutputInput(OutVars, InpVars, OutName, InpName, Field, ErrStat end subroutine +!------------------------------------------------------------------------------- +! Flag Utilities +!------------------------------------------------------------------------------- + +subroutine SetFlags(Var, Mask) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Mask + integer(IntKi) :: i + Var%Flags = ior(Var%Flags, Mask) +end subroutine + !------------------------------------------------------------------------------- ! String Utilities !------------------------------------------------------------------------------- @@ -635,18 +811,49 @@ pure function wm_from_quat(q) result(c) c = 4.0_R8Ki*e/(1.0_R8Ki + e0) end function +! pure function wm_to_dcm(c) result(R) +! real(R8Ki), intent(in) :: c(3) +! real(R8Ki) :: R(3, 3) +! R = quat_to_dcm(wm_to_quat(c)) +! end function + pure function wm_to_dcm(c) result(R) real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: R(3, 3) - R = quat_to_dcm(wm_to_quat(c)) + real(R8Ki) :: R(3, 3), cct, F(3, 3) + integer(IntKi) :: i, j + cct = dot_product(c, c) + F = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3])/2.0_R8Ki + do i = 1, 3 + F(i, i) = F(i, i) + 1.0_R8Ki - cct/16.0_R8Ki + do j = 1, 3 + F(i, j) = F(i, j) + c(i)*c(j)/8.0_R8Ki + end do + end do + F = F/(1.0_R8Ki + cct/16.0_R8Ki) + R = matmul(F, F) end function pure function wm_from_dcm(R) result(c) real(R8Ki), intent(in) :: R(3, 3) - real(R8Ki) :: c(3) + real(R8Ki) :: c(3), cct c = wm_from_quat(dcm_to_quat(R)) + cct = dot_product(c, c) + if (cct > 16.0_R8Ki) c = 16.0_R8Ki*c/cct end function +! pure function wm_from_dcm(R) result(c) +! real(R8Ki), intent(in) :: R(3, 3) +! real(R8Ki) :: c(3), t1, t2, cct +! t1 = 1.0_R8Ki + R(1,1) + R(2,2) + R(3,3) +! t2 = 2.0_R8Ki*sqrt(t1) +! c(1) = (R(3,2) - R(2,3)) +! c(2) = (R(1,3) - R(3,1)) +! c(3) = (R(2,1) - R(1,2)) +! c = 4.0_R8Ki * c / (t1 + t2) +! cct = dot_product(c,c) +! if (cct > 16.0_R8Ki) c = 16.0_R8Ki*c / cct +! end function + pure function wm_compose(p, q) result(r) real(R8Ki), intent(in) :: p(3), q(3) real(R8Ki) :: r(3) @@ -674,18 +881,32 @@ pure function wm_to_zyx(c) result(zyx) zyx(3) = atan2(2.0_R8Ki*(qw*qz + qx*qy), 1.0_R8Ki - 2.0_R8Ki*(qy*qy + qz*qz)) end function +function wm_to_xyz(c) result(xyz) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: xyz(3) + xyz = EulerExtract(wm_to_dcm(c)) +end function + pure function wm_inv(c) result(cinv) real(R8Ki), intent(in) :: c(3) real(R8Ki) :: cinv(3) cinv = -c end function +pure function wm_from_xyz(xyz) result(c) + real(R8Ki), intent(in) :: xyz(3) + real(R8Ki) :: c(3) + real(R8Ki) :: n(3) + c = 0.0_R8Ki + c = wm_compose([4, 0, 0]*tan(xyz(1)/4.0_R8Ki), c) ! X + c = wm_compose([0, 4, 0]*tan(xyz(2)/4.0_R8Ki), c) ! Y + c = wm_compose([0, 0, 4]*tan(xyz(3)/4.0_R8Ki), c) ! Z +end function + pure function cross(a, b) result(c) real(R8Ki), intent(in) :: a(3), b(3) real(R8Ki) :: c(3) - c = [a(2)*b(3) - a(3)*b(2), & - -a(3)*b(1) + a(1)*b(3), & - a(1)*b(2) - a(2)*b(1)] + c = [a(2)*b(3) - a(3)*b(2), -a(3)*b(1) + a(1)*b(3), a(1)*b(2) - a(2)*b(1)] end function end module diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index ec261884ec..b383f306a1 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -51,6 +51,8 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_NoLin = 8 ! Variable to be linearized [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 16 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 32 ! Variable used for input residual calculation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] @@ -118,7 +120,8 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: NumLin = 0 !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUsr !< user defined indices for variable [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGbl !< indices in global arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblSol !< indices in global arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblLin !< indices in global arrays [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iy !< indices of output to sum for input [-] REAL(R8Ki) :: Perturb = 0 !< perturbation [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] @@ -134,10 +137,6 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: Nx = 0_IntKi !< [-] INTEGER(IntKi) :: Nu = 0_IntKi !< [-] INTEGER(IntKi) :: Ny = 0_IntKi !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ixg !< index array mapping local x vector to global x vector [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iug !< index array mapping local u vector to global u vector [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyg !< index array mapping local y vector to global y vector [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iyu !< index array mapping local y vector to global y vector [-] END TYPE ModVarsType ! ======================= ! ========= ModValsType ======= @@ -162,12 +161,17 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: ModDataType INTEGER(IntKi) :: ID = 0 !< [-] character(ChanLen) :: Abbr !< [-] - INTEGER(IntKi) :: Instance = 0 !< [-] + INTEGER(IntKi) :: Ins = 0 !< [-] REAL(R8Ki) :: DT = 0 !< [-] INTEGER(IntKi) :: SubSteps = 0 !< [-] INTEGER(IntKi) :: SolveOption = 0 !< [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< [-] - TYPE(ModValsType) , POINTER :: Vals => NULL() !< [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMapsOpt1 !< array of mapping indices where this module is the input [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMapsOpt2 !< array of mapping indices where this module is the input [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMapsAll !< array of mapping indices where this module is the input [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] END TYPE ModDataType ! ======================= CONTAINS @@ -788,17 +792,29 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr end if DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc end if - if (allocated(SrcModVarTypeData%iGbl)) then - LB(1:1) = lbound(SrcModVarTypeData%iGbl) - UB(1:1) = ubound(SrcModVarTypeData%iGbl) - if (.not. allocated(DstModVarTypeData%iGbl)) then - allocate(DstModVarTypeData%iGbl(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModVarTypeData%iGblSol)) then + LB(1:1) = lbound(SrcModVarTypeData%iGblSol) + UB(1:1) = ubound(SrcModVarTypeData%iGblSol) + if (.not. allocated(DstModVarTypeData%iGblSol)) then + allocate(DstModVarTypeData%iGblSol(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iGbl.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iGblSol.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModVarTypeData%iGbl = SrcModVarTypeData%iGbl + DstModVarTypeData%iGblSol = SrcModVarTypeData%iGblSol + end if + if (allocated(SrcModVarTypeData%iGblLin)) then + LB(1:1) = lbound(SrcModVarTypeData%iGblLin) + UB(1:1) = ubound(SrcModVarTypeData%iGblLin) + if (.not. allocated(DstModVarTypeData%iGblLin)) then + allocate(DstModVarTypeData%iGblLin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iGblLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iGblLin = SrcModVarTypeData%iGblLin end if if (allocated(SrcModVarTypeData%iy)) then LB(1:2) = lbound(SrcModVarTypeData%iy) @@ -840,8 +856,11 @@ subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) if (allocated(ModVarTypeData%iLoc)) then deallocate(ModVarTypeData%iLoc) end if - if (allocated(ModVarTypeData%iGbl)) then - deallocate(ModVarTypeData%iGbl) + if (allocated(ModVarTypeData%iGblSol)) then + deallocate(ModVarTypeData%iGblSol) + end if + if (allocated(ModVarTypeData%iGblLin)) then + deallocate(ModVarTypeData%iGblLin) end if if (allocated(ModVarTypeData%iy)) then deallocate(ModVarTypeData%iy) @@ -874,10 +893,15 @@ subroutine NWTC_Library_PackModVarType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%iLoc), ubound(InData%iLoc)) call RegPack(Buf, InData%iLoc) end if - call RegPack(Buf, allocated(InData%iGbl)) - if (allocated(InData%iGbl)) then - call RegPackBounds(Buf, 1, lbound(InData%iGbl), ubound(InData%iGbl)) - call RegPack(Buf, InData%iGbl) + call RegPack(Buf, allocated(InData%iGblSol)) + if (allocated(InData%iGblSol)) then + call RegPackBounds(Buf, 1, lbound(InData%iGblSol), ubound(InData%iGblSol)) + call RegPack(Buf, InData%iGblSol) + end if + call RegPack(Buf, allocated(InData%iGblLin)) + if (allocated(InData%iGblLin)) then + call RegPackBounds(Buf, 1, lbound(InData%iGblLin), ubound(InData%iGblLin)) + call RegPack(Buf, InData%iGblLin) end if call RegPack(Buf, allocated(InData%iy)) if (allocated(InData%iy)) then @@ -945,18 +969,32 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) call RegUnpack(Buf, OutData%iLoc) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iGbl)) deallocate(OutData%iGbl) + if (allocated(OutData%iGblSol)) deallocate(OutData%iGblSol) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iGblSol(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iGblSol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iGblSol) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iGblLin)) deallocate(OutData%iGblLin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iGbl(LB(1):UB(1)),stat=stat) + allocate(OutData%iGblLin(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iGbl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iGblLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iGbl) + call RegUnpack(Buf, OutData%iGblLin) if (RegCheckErr(Buf, RoutineName)) return end if if (allocated(OutData%iy)) deallocate(OutData%iy) @@ -997,8 +1035,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, 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) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' @@ -1057,62 +1095,14 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny - if (allocated(SrcModVarsTypeData%ixg)) then - LB(1:1) = lbound(SrcModVarsTypeData%ixg) - UB(1:1) = ubound(SrcModVarsTypeData%ixg) - if (.not. allocated(DstModVarsTypeData%ixg)) then - allocate(DstModVarsTypeData%ixg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%ixg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarsTypeData%ixg = SrcModVarsTypeData%ixg - end if - if (allocated(SrcModVarsTypeData%iug)) then - LB(1:1) = lbound(SrcModVarsTypeData%iug) - UB(1:1) = ubound(SrcModVarsTypeData%iug) - if (.not. allocated(DstModVarsTypeData%iug)) then - allocate(DstModVarsTypeData%iug(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iug.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarsTypeData%iug = SrcModVarsTypeData%iug - end if - if (allocated(SrcModVarsTypeData%iyg)) then - LB(1:1) = lbound(SrcModVarsTypeData%iyg) - UB(1:1) = ubound(SrcModVarsTypeData%iyg) - if (.not. allocated(DstModVarsTypeData%iyg)) then - allocate(DstModVarsTypeData%iyg(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iyg.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarsTypeData%iyg = SrcModVarsTypeData%iyg - end if - if (allocated(SrcModVarsTypeData%iyu)) then - LB(1:2) = lbound(SrcModVarsTypeData%iyu) - UB(1:2) = ubound(SrcModVarsTypeData%iyu) - if (.not. allocated(DstModVarsTypeData%iyu)) then - allocate(DstModVarsTypeData%iyu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%iyu.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarsTypeData%iyu = SrcModVarsTypeData%iyu - end if end subroutine subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) type(ModVarsType), intent(inout) :: ModVarsTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarsType' @@ -1145,26 +1135,14 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) end do deallocate(ModVarsTypeData%y) end if - if (allocated(ModVarsTypeData%ixg)) then - deallocate(ModVarsTypeData%ixg) - end if - if (allocated(ModVarsTypeData%iug)) then - deallocate(ModVarsTypeData%iug) - end if - if (allocated(ModVarsTypeData%iyg)) then - deallocate(ModVarsTypeData%iyg) - end if - if (allocated(ModVarsTypeData%iyu)) then - deallocate(ModVarsTypeData%iyu) - end if end subroutine subroutine NWTC_Library_PackModVarsType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ModVarsType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarsType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%ModNum) call RegPack(Buf, InData%ModAbbr) @@ -1198,26 +1176,6 @@ subroutine NWTC_Library_PackModVarsType(Buf, Indata) call RegPack(Buf, InData%Nx) call RegPack(Buf, InData%Nu) call RegPack(Buf, InData%Ny) - call RegPack(Buf, allocated(InData%ixg)) - if (allocated(InData%ixg)) then - call RegPackBounds(Buf, 1, lbound(InData%ixg), ubound(InData%ixg)) - call RegPack(Buf, InData%ixg) - end if - call RegPack(Buf, allocated(InData%iug)) - if (allocated(InData%iug)) then - call RegPackBounds(Buf, 1, lbound(InData%iug), ubound(InData%iug)) - call RegPack(Buf, InData%iug) - end if - call RegPack(Buf, allocated(InData%iyg)) - if (allocated(InData%iyg)) then - call RegPackBounds(Buf, 1, lbound(InData%iyg), ubound(InData%iyg)) - call RegPack(Buf, InData%iyg) - end if - call RegPack(Buf, allocated(InData%iyu)) - if (allocated(InData%iyu)) then - call RegPackBounds(Buf, 2, lbound(InData%iyu), ubound(InData%iyu)) - call RegPack(Buf, InData%iyu) - end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1225,8 +1183,8 @@ subroutine NWTC_Library_UnPackModVarsType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ModVarsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarsType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1285,62 +1243,6 @@ subroutine NWTC_Library_UnPackModVarsType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Ny) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ixg)) deallocate(OutData%ixg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ixg(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ixg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ixg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iug)) deallocate(OutData%iug) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iug(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iug.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iug) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iyg)) deallocate(OutData%iyg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iyg(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iyg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iyu)) deallocate(OutData%iyu) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iyu(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iyu) - if (RegCheckErr(Buf, RoutineName)) return - end if end subroutine subroutine NWTC_Library_CopyModValsType(SrcModValsTypeData, DstModValsTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1865,7 +1767,7 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(0), UB(0) + integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' @@ -1873,12 +1775,83 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, ErrMsg = '' DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr - DstModDataTypeData%Instance = SrcModDataTypeData%Instance + DstModDataTypeData%Ins = SrcModDataTypeData%Ins DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps DstModDataTypeData%SolveOption = SrcModDataTypeData%SolveOption + if (allocated(SrcModDataTypeData%ixs)) then + LB(1:2) = lbound(SrcModDataTypeData%ixs) + UB(1:2) = ubound(SrcModDataTypeData%ixs) + if (.not. allocated(DstModDataTypeData%ixs)) then + allocate(DstModDataTypeData%ixs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ixs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%ixs = SrcModDataTypeData%ixs + end if + if (allocated(SrcModDataTypeData%ius)) then + LB(1:2) = lbound(SrcModDataTypeData%ius) + UB(1:2) = ubound(SrcModDataTypeData%ius) + if (.not. allocated(DstModDataTypeData%ius)) then + allocate(DstModDataTypeData%ius(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ius.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%ius = SrcModDataTypeData%ius + end if + if (allocated(SrcModDataTypeData%iys)) then + LB(1:2) = lbound(SrcModDataTypeData%iys) + UB(1:2) = ubound(SrcModDataTypeData%iys) + if (.not. allocated(DstModDataTypeData%iys)) then + allocate(DstModDataTypeData%iys(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iys.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%iys = SrcModDataTypeData%iys + end if + if (allocated(SrcModDataTypeData%iMapsOpt1)) then + LB(1:1) = lbound(SrcModDataTypeData%iMapsOpt1) + UB(1:1) = ubound(SrcModDataTypeData%iMapsOpt1) + if (.not. allocated(DstModDataTypeData%iMapsOpt1)) then + allocate(DstModDataTypeData%iMapsOpt1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iMapsOpt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%iMapsOpt1 = SrcModDataTypeData%iMapsOpt1 + end if + if (allocated(SrcModDataTypeData%iMapsOpt2)) then + LB(1:1) = lbound(SrcModDataTypeData%iMapsOpt2) + UB(1:1) = ubound(SrcModDataTypeData%iMapsOpt2) + if (.not. allocated(DstModDataTypeData%iMapsOpt2)) then + allocate(DstModDataTypeData%iMapsOpt2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iMapsOpt2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%iMapsOpt2 = SrcModDataTypeData%iMapsOpt2 + end if + if (allocated(SrcModDataTypeData%iMapsAll)) then + LB(1:1) = lbound(SrcModDataTypeData%iMapsAll) + UB(1:1) = ubound(SrcModDataTypeData%iMapsAll) + if (.not. allocated(DstModDataTypeData%iMapsAll)) then + allocate(DstModDataTypeData%iMapsAll(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iMapsAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%iMapsAll = SrcModDataTypeData%iMapsAll + end if DstModDataTypeData%Vars => SrcModDataTypeData%Vars - DstModDataTypeData%Vals => SrcModDataTypeData%Vals end subroutine subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) @@ -1890,8 +1863,25 @@ subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' ErrStat = ErrID_None ErrMsg = '' + if (allocated(ModDataTypeData%ixs)) then + deallocate(ModDataTypeData%ixs) + end if + if (allocated(ModDataTypeData%ius)) then + deallocate(ModDataTypeData%ius) + end if + if (allocated(ModDataTypeData%iys)) then + deallocate(ModDataTypeData%iys) + end if + if (allocated(ModDataTypeData%iMapsOpt1)) then + deallocate(ModDataTypeData%iMapsOpt1) + end if + if (allocated(ModDataTypeData%iMapsOpt2)) then + deallocate(ModDataTypeData%iMapsOpt2) + end if + if (allocated(ModDataTypeData%iMapsAll)) then + deallocate(ModDataTypeData%iMapsAll) + end if nullify(ModDataTypeData%Vars) - nullify(ModDataTypeData%Vals) end subroutine subroutine NWTC_Library_PackModDataType(Buf, Indata) @@ -1902,10 +1892,40 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%ID) call RegPack(Buf, InData%Abbr) - call RegPack(Buf, InData%Instance) + call RegPack(Buf, InData%Ins) call RegPack(Buf, InData%DT) call RegPack(Buf, InData%SubSteps) call RegPack(Buf, InData%SolveOption) + call RegPack(Buf, allocated(InData%ixs)) + if (allocated(InData%ixs)) then + call RegPackBounds(Buf, 2, lbound(InData%ixs), ubound(InData%ixs)) + call RegPack(Buf, InData%ixs) + end if + call RegPack(Buf, allocated(InData%ius)) + if (allocated(InData%ius)) then + call RegPackBounds(Buf, 2, lbound(InData%ius), ubound(InData%ius)) + call RegPack(Buf, InData%ius) + end if + call RegPack(Buf, allocated(InData%iys)) + if (allocated(InData%iys)) then + call RegPackBounds(Buf, 2, lbound(InData%iys), ubound(InData%iys)) + call RegPack(Buf, InData%iys) + end if + call RegPack(Buf, allocated(InData%iMapsOpt1)) + if (allocated(InData%iMapsOpt1)) then + call RegPackBounds(Buf, 1, lbound(InData%iMapsOpt1), ubound(InData%iMapsOpt1)) + call RegPack(Buf, InData%iMapsOpt1) + end if + call RegPack(Buf, allocated(InData%iMapsOpt2)) + if (allocated(InData%iMapsOpt2)) then + call RegPackBounds(Buf, 1, lbound(InData%iMapsOpt2), ubound(InData%iMapsOpt2)) + call RegPack(Buf, InData%iMapsOpt2) + end if + call RegPack(Buf, allocated(InData%iMapsAll)) + if (allocated(InData%iMapsAll)) then + call RegPackBounds(Buf, 1, lbound(InData%iMapsAll), ubound(InData%iMapsAll)) + call RegPack(Buf, InData%iMapsAll) + end if call RegPack(Buf, associated(InData%Vars)) if (associated(InData%Vars)) then call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) @@ -1913,13 +1933,6 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) call NWTC_Library_PackModVarsType(Buf, InData%Vars) end if end if - call RegPack(Buf, associated(InData%Vals)) - if (associated(InData%Vals)) then - call RegPackPointer(Buf, c_loc(InData%Vals), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModValsType(Buf, InData%Vals) - end if - end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1927,7 +1940,7 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ModDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' - integer(IntKi) :: LB(0), UB(0) + integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -1937,7 +1950,7 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Abbr) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Instance) + call RegUnpack(Buf, OutData%Ins) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return @@ -1945,6 +1958,90 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SolveOption) if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ixs)) deallocate(OutData%ixs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ixs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ixs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ixs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ius)) deallocate(OutData%ius) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ius(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ius.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ius) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iys)) deallocate(OutData%iys) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iys(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iys.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iys) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iMapsOpt1)) deallocate(OutData%iMapsOpt1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iMapsOpt1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iMapsOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iMapsOpt1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iMapsOpt2)) deallocate(OutData%iMapsOpt2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iMapsOpt2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iMapsOpt2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iMapsOpt2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iMapsAll)) deallocate(OutData%iMapsAll) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iMapsAll(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iMapsAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iMapsAll) + if (RegCheckErr(Buf, RoutineName)) return + end if if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1965,26 +2062,6 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) else OutData%Vars => null() end if - if (associated(OutData%Vals)) deallocate(OutData%Vals) - 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%Vals) - else - allocate(OutData%Vals,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Vals) - call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals - end if - else - OutData%Vals => null() - end if end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index ff96a7c199..b379b8971e 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -57,6 +57,8 @@ param ^ - IntKi VF_Line - 2 - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - param ^ - IntKi VF_NoLin - 8 - "Variable to be linearized" - param ^ - IntKi VF_Ext - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_Solve - 32 - "Variable used for input residual calculation" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -73,7 +75,8 @@ typedef ^ ^ IntKi DerivOrder - 0 - typedef ^ ^ IntKi NumLin - 0 - "" - typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iGbl : - - "indices in global arrays" - +typedef ^ ^ IntKi iGblSol : - - "indices in global arrays" - +typedef ^ ^ IntKi iGblLin : - - "indices in global arrays" - typedef ^ ^ IntKi iy :: - - "indices of output to sum for input" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - @@ -86,10 +89,6 @@ typedef ^ ^ ModVarType y : - - typedef ^ ^ IntKi Nx - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ IntKi ixg : - - "index array mapping local x vector to global x vector" - -typedef ^ ^ IntKi iug : - - "index array mapping local u vector to global u vector" - -typedef ^ ^ IntKi iyg : - - "index array mapping local y vector to global y vector" - -typedef ^ ^ IntKi iyu :: - - "index array mapping local y vector to global y vector" - typedef ^ ModValsType R8Ki x : - - "" - typedef ^ ^ R8Ki dxdt : - - "" - @@ -108,12 +107,17 @@ typedef ^ ^ R8Ki dXdu :: - - typedef ^ ModDataType IntKi ID - 0 - "" - typedef ^ ^ character(ChanLen) Abbr - - - "" - -typedef ^ ^ IntKi Instance - 0 - "" - +typedef ^ ^ IntKi Ins - 0 - "" - typedef ^ ^ R8Ki DT - 0 - "" - typedef ^ ^ IntKi SubSteps - 0 - "" - typedef ^ ^ IntKi SolveOption - 0 - "" - -typedef ^ ^ ModVarsType *Vars - - - "" - -typedef ^ ^ ModValsType *Vals - - - "" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ IntKi iMapsOpt1 : - - "array of mapping indices where this module is the input" - +typedef ^ ^ IntKi iMapsOpt2 : - - "array of mapping indices where this module is the input" - +typedef ^ ^ IntKi iMapsAll : - - "array of mapping indices where this module is the input" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 84f0f80f09..47fc39a6d8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -57,6 +57,8 @@ param ^ - IntKi VF_Line - 2 - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - param ^ - IntKi VF_NoLin - 8 - "Variable to be linearized" - param ^ - IntKi VF_Ext - 16 - "Variable for extended linearization" - +param ^ - IntKi VF_Solve - 32 - "Variable used for input residual calculation" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - param ^ - IntKi VC_None - 0 - "" - param ^ - IntKi VC_Tight - 1 - "" - @@ -73,7 +75,8 @@ typedef ^ ^ IntKi DerivOrder - 0 - typedef ^ ^ IntKi NumLin - 0 - "" - typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iGbl : - - "indices in global arrays" - +typedef ^ ^ IntKi iGblSol : - - "indices in global arrays" - +typedef ^ ^ IntKi iGblLin : - - "indices in global arrays" - typedef ^ ^ IntKi iy :: - - "indices of output to sum for input" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - @@ -86,10 +89,6 @@ typedef ^ ^ ModVarType y : - - typedef ^ ^ IntKi Nx - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - -typedef ^ ^ IntKi ixg : - - "index array mapping local x vector to global x vector" - -typedef ^ ^ IntKi iug : - - "index array mapping local u vector to global u vector" - -typedef ^ ^ IntKi iyg : - - "index array mapping local y vector to global y vector" - -typedef ^ ^ IntKi iyu :: - - "index array mapping local y vector to global y vector" - typedef ^ ModValsType R8Ki x : - - "" - typedef ^ ^ R8Ki dxdt : - - "" - @@ -108,9 +107,14 @@ typedef ^ ^ R8Ki dXdu :: - - typedef ^ ModDataType IntKi ID - 0 - "" - typedef ^ ^ character(ChanLen) Abbr - - - "" - -typedef ^ ^ IntKi Instance - 0 - "" - +typedef ^ ^ IntKi Ins - 0 - "" - typedef ^ ^ R8Ki DT - 0 - "" - typedef ^ ^ IntKi SubSteps - 0 - "" - typedef ^ ^ IntKi SolveOption - 0 - "" - -typedef ^ ^ ModVarsType *Vars - - - "" - -typedef ^ ^ ModValsType *Vals - - - "" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ IntKi iMapsOpt1 : - - "array of mapping indices where this module is the input" - +typedef ^ ^ IntKi iMapsOpt2 : - - "array of mapping indices where this module is the input" - +typedef ^ ^ IntKi iMapsAll : - - "array of mapping indices where this module is the input" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - From bde06b8365ed93551991dea85820a641a68e3b27 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 16 Aug 2023 00:44:49 +0000 Subject: [PATCH 09/61] Updated ElastoDyn for more TC changes --- modules/elastodyn/src/ElastoDyn.f90 | 594 +++++++++---------- modules/elastodyn/src/ElastoDyn_Registry.txt | 3 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 87 +-- 3 files changed, 295 insertions(+), 389 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 56f07b3256..dd2587fea8 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -70,108 +70,6 @@ MODULE ElastoDyn CONTAINS -subroutine ED_PackStateValues(p, x, arr) - type(ED_ParameterType), intent(in) :: p - type(ED_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: arr(:) - integer(IntKi) :: i - arr = 0.0_R8Ki - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (VF_TransDisp, VF_AngularDisp) - arr(p%Vars%x(i)%iLoc) = x%QT(p%Vars%x(i)%iUsr) - case (VF_TransVel, VF_AngularVel) - arr(p%Vars%x(i)%iLoc) = x%QDT(p%Vars%x(i)%iUsr) - end select - end do -end subroutine - -subroutine ED_UnpackStateValues(p, arr, x) - type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: arr(:) - type(ED_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (VF_TransDisp, VF_AngularDisp) - x%QT(p%Vars%x(i)%iUsr) = arr(p%Vars%x(i)%iLoc) - case (VF_TransVel, VF_AngularVel) - x%QDT(p%Vars%x(i)%iUsr) = arr(p%Vars%x(i)%iLoc) - end select - end do -end subroutine - -subroutine ED_PackInputValues(p, u, arr) - type(ED_ParameterType), intent(in) :: p - type(ED_InputType), intent(in) :: u - real(R8Ki), intent(out) :: arr(:) - integer(IntKi) :: iv, i - arr = 0.0_R8Ki - iv = 1 - if (allocated(u%BladePtLoads)) then - do i = 1, size(u%BladePtLoads) - call MV_PackMesh(p%Vars%u(iv:iv+1), u%BladePtLoads(i), arr); iv = iv + 2 - end do - end if - call MV_PackMesh(p%Vars%u(iv:iv+1), u%PlatformPtMesh, arr); iv = iv + 2 - call MV_PackMesh(p%Vars%u(iv:iv+1), u%TowerPtLoads, arr); iv = iv + 2 - call MV_PackMesh(p%Vars%u(iv:iv+1), u%HubPtLoad, arr); iv = iv + 2 - call MV_PackMesh(p%Vars%u(iv:iv+1), u%NacelleLoads, arr); iv = iv + 2 - arr(p%Vars%u(iv)%iLoc) = pack(u%BlPitchCom,.true.); iv = iv + 1 - arr(p%Vars%u(iv)%iLoc) = u%YawMom; iv = iv + 1 - arr(p%Vars%u(iv)%iLoc) = u%GenTrq; iv = iv + 1 - arr(p%Vars%u(p%iBlPitchComCVar)%iLoc) = u%BlPitchCom(1) ! extended -end subroutine - -subroutine ED_UnpackInputValues(p, arr, u) - type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: arr(:) - type(ED_InputType), intent(inout) :: u - integer(IntKi) :: iv, i - iv = 1 - if (allocated(u%BladePtLoads)) then - do i = 1, size(u%BladePtLoads) - call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%BladePtLoads(i)); iv = iv + 2 - end do - end if - call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%PlatformPtMesh); iv = iv + 2 - call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%TowerPtLoads); iv = iv + 2 - call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%HubPtLoad); iv = iv + 2 - call MV_UnpackMesh(p%Vars%u(iv:iv+1), arr, u%NacelleLoads); iv = iv + 2 - u%BlPitchCom = arr(p%Vars%u(iv)%iLoc); iv = iv + 1 - u%YawMom = arr(p%Vars%u(iv)%iLoc(1)); iv = iv + 1 - u%GenTrq = arr(p%Vars%u(iv)%iLoc(1)); iv = iv + 1 -end subroutine - -subroutine ED_PackOutputValues(p, y, arr) - type(ED_ParameterType), intent(in) :: p - type(ED_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: arr(:) - integer(IntKi) :: iv, i - arr = 0.0_R8Ki - iv = 1 - if (allocated(y%BladeLn2Mesh)) then - do i = 1, size(y%BladeLn2Mesh) - call MV_PackMesh(p%Vars%y(iv:iv+5), y%BladeLn2Mesh(i), arr); iv = iv + 6 - end do - end if - call MV_PackMesh(p%Vars%y(iv:iv+5), y%PlatformPtMesh, arr); iv = iv + 6 - call MV_PackMesh(p%Vars%y(iv:iv+5), y%TowerLn2Mesh, arr); iv = iv + 6 - call MV_PackMesh(p%Vars%y(iv:iv+2), y%HubPtMotion, arr); iv = iv + 3 - if (allocated(y%BladeRootMotion)) then - do i = 1, size(y%BladeRootMotion) - call MV_PackMesh(p%Vars%y(iv:iv+5), y%BladeRootMotion(i), arr); iv = iv + 6 - end do - end if - call MV_PackMesh(p%Vars%y(iv:iv+5), y%NacelleMotion, arr); iv = iv + 6 - arr(p%Vars%y(iv)%iLoc) = y%Yaw; iv = iv + 1 - arr(p%Vars%y(iv)%iLoc) = y%YawRate; iv = iv + 1 - arr(p%Vars%y(iv)%iLoc) = y%HSS_Spd; iv = iv + 1 - do while (iv <= size(p%Vars%y)) - arr(p%Vars%y(iv)%iLoc(1)) = y%WriteOutput(p%Vars%y(iv)%iUsr(1)); iv = iv + 1 - end do -end subroutine - !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. @@ -207,10 +105,6 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut INTEGER(IntKi) :: i, j, k ! loop counters CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None REAL(R8Ki) :: TransMat(3,3) ! Initial rotation matrix at Platform Refz - REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength - INTEGER(IntKi) :: iv - INTEGER(IntKi), allocatable :: imv(:) - TYPE(ModVarType) :: Var ! Initialize variables for this routine @@ -354,7 +248,8 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Platform reference point wrt to global origin (0,0,0) InitOut%PlatformPos = x%QT(1:6) - CALL SmllRotTrans('initial platform rotation', x%QT(4), x%QT(5), x%QT(6), TransMat, '', ErrStat2, ErrMsg2) + ! CALL SmllRotTrans('initial platform rotation', x%QT(4), x%QT(5), x%QT(6), TransMat, '', ErrStat2, ErrMsg2) + TransMat = wm_to_dcm(wm_from_xyz([x%QT(DOF_R), x%QT(DOF_P), x%QT(DOF_Y)])) InitOut%PlatformPos(1) = InitOut%PlatformPos(1) - TransMat(3,1)*p%PtfmRefzt InitOut%PlatformPos(2) = InitOut%PlatformPos(2) - TransMat(3,2)*p%PtfmRefzt InitOut%PlatformPos(3) = InitOut%PlatformPos(3) - TransMat(3,3)*p%PtfmRefzt + p%PtfmRefzt @@ -414,9 +309,94 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Module Variables !............................................................................................ + CALL Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + + !............................................................................................ + ! Summary and cleanup + !............................................................................................ + + ! Print the summary file if requested: + IF (InputFileData%SumPrint) THEN + CALL ED_PrintSum( p, OtherState, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + END IF + + ! Destroy the InputFileData structure (deallocate arrays) + + CALL ED_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + +CONTAINS + !............................................................................................................................... + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev + !............................................................................................................................... + + ! Passed arguments + INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) + CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) + + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + !............................................................................................................................ + ! Set error status/message; + !............................................................................................................................ + + IF ( ErrID /= ErrID_None ) THEN + + IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine + ErrMsg = TRIM(ErrMsg)//'ED_Init:'//TRIM(Msg) + ErrStat = MAX(ErrStat, ErrID) + + !......................................................................................................................... + ! Clean up if we're going to return on error: close files, deallocate local arrays + !......................................................................................................................... + IF ( ErrStat >= AbortErrLev ) THEN + CALL ED_DestroyInputFile(InputFileData, ErrStat3, ErrMsg3 ) + END IF + + END IF + + + END SUBROUTINE CheckError + +END SUBROUTINE ED_Init +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ErrMsg) + TYPE(ED_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(ED_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(ED_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + TYPE(ED_InputFile), INTENT(IN ) :: InputFileData !< Input file data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j, flags + REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + TYPE(ModVarType) :: Var + ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Associate pointers in initialization output + InitOut%Vars => p%Vars !---------------------------------------------------------------------------- ! Continuous State Variables @@ -568,22 +548,25 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) end do end if - + ! Platform point loads call MV_AddMeshVar(p%Vars%u, "Platform", LoadFields, & + Nodes=u%PlatformPtMesh%NNodes, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Tower point loads call MV_AddMeshVar(p%Vars%u, "Tower", LoadFields, & - Nodes=p%TwrNodes, & + Nodes=u%TowerPtLoads%Nnodes, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) ! Hub point loads call MV_AddMeshVar(p%Vars%u, "Hub", LoadFields, & + Nodes=u%HubPtLoad%NNodes, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Nacelle point loads call MV_AddMeshVar(p%Vars%u, "Nacelle", LoadFields, & + Nodes=u%NacelleLoads%NNodes, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Non-mesh input variables @@ -614,16 +597,18 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Output variables !---------------------------------------------------------------------------- + if (allocated(y%BladeLn2Mesh))then + do i = 1, p%NumBl + call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), MotionFields, Nodes=y%BladeLn2Mesh(i)%Nnodes, Flags=VF_Line) + end do + end if + call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields, Nodes=y%PlatformPtMesh%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, Nodes=y%TowerLn2Mesh%Nnodes, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'Hub', [VF_TransDisp, VF_Orientation, VF_AngularVel], Nodes=y%HubPtMotion%Nnodes) do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), MotionFields, Nodes=p%BldNodes+2, Flags=VF_Line) - end do - call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields) - call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, Nodes=p%TwrNodes+2, Flags=VF_Line) - call MV_AddMeshVar(p%Vars%y, 'Hub', [VF_TransDisp, VF_Orientation, VF_AngularVel]) - do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields) + call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields, Nodes=y%BladeRootMotion(i)%Nnodes) end do - call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields) + call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields, Nodes=y%NacelleMotion%Nnodes) call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, LinNames=['Yaw, rad']) call MV_AddVar(p%Vars%y, 'YawRate', VF_Scalar, LinNames=['YawRate, rad/s']) call MV_AddVar(p%Vars%y, 'HSS_Spd', VF_Scalar, LinNames=['HSS_Spd, rad/s']) @@ -646,107 +631,53 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Initialize Variables and Values !---------------------------------------------------------------------------- - CALL MV_InitVars(p%Vars, m%Vals, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2, ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - - if (InitInp%Linearize) then - ! State Variables - CALL AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) - CALL AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) - CALL AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) - if (ErrStat >= AbortErrLev) return - InitOut%DerivOrder_x = 2 - do i = 1, size(p%Vars%x) - do j = 1, p%Vars%x(i)%NumLin - InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames - InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 - end do - end do - - ! Input Variables - call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); call CheckError(ErrStat2, ErrMsg2) - call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); call CheckError(ErrStat2, ErrMsg2) - call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); call CheckError(ErrStat2, ErrMsg2) - if (ErrStat >= AbortErrLev) return - do i = 1, size(p%Vars%u) - do j = 1, p%Vars%u(i)%NumLin - InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames - InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 - InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 - end do - end do - - ! Output variables - CALL AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) - CALL AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); CALL CheckError(ErrStat2, ErrMsg2) - if (ErrStat >= AbortErrLev) return - do i = 1, size(p%Vars%y) - do j = 1, p%Vars%y(i)%NumLin - InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames - InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 - end do - end do - end if - - ! Associate pointers in initialization output - InitOut%Vars => p%Vars - InitOut%Vals => m%Vals - - !............................................................................................ - ! Summary and cleanup - !............................................................................................ - - ! Print the summary file if requested: - IF (InputFileData%SumPrint) THEN - CALL ED_PrintSum( p, OtherState, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - ! Destroy the InputFileData structure (deallocate arrays) + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return - CALL ED_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'ED_Init:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- - !......................................................................................................................... - ! Clean up if we're going to return on error: close files, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - CALL ED_DestroyInputFile(InputFileData, ErrStat3, ErrMsg3 ) - END IF + ! If linearization is not requested, return + if (.not. InitInp%Linearize) return - END IF + ! State Variables + CALL AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + InitOut%DerivOrder_x = 2 + do i = 1, size(p%Vars%x) + do j = 1, p%Vars%x(i)%NumLin + InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames + InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 + end do + end do + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%NumLin + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do - END SUBROUTINE CheckError + ! Output variables + CALL AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%NumLin + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 + end do + end do +contains function OutParamFlags(indx) result(flags) integer(IntKi), intent(in) :: indx integer(IntKi) :: flags @@ -765,8 +696,11 @@ function OutParamFlags(indx) result(flags) flags = VF_None end if end function - -END SUBROUTINE ED_Init + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE ED_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) @@ -2278,7 +2212,7 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, END SUBROUTINE ED_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states. -SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg, dxdtarr ) +SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -2292,7 +2226,6 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta TYPE(ED_ContinuousStateType), INTENT(INOUT) :: dxdt !< Continuous state derivatives at t [intent in so we don't need to allocate/deallocate constantly] INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), OPTIONAL, INTENT(INOUT) :: dxdtarr(:) !< Array for packing the continuous state derivatives ! LOCAL variables LOGICAL, PARAMETER :: UpdateValues = .TRUE. ! determines if the OtherState values need to be updated @@ -2397,13 +2330,7 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ! This will be used during the next call to RtHS (bjj: currently violates framework, but DOE wants a hack for HSS brake). ! need m%QD2T set before calling this - !OtherState%SgnPrvLSTQ = SignLSSTrq(p, m) - - ! If derivative array is present, pack derivative data - if (present(dxdtarr)) then - call ED_PackStateValues(p, dxdt, dxdtarr) - end if - + !OtherState%SgnPrvLSTQ = SignLSSTrq(p, m) END SUBROUTINE ED_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- @@ -10639,40 +10566,24 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function ! make a copy of the inputs to perturb - call ED_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call ED_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Pack operating point input values for perturbations call ED_PackInputValues(p, u, m%Vals%u) - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + IF ( PRESENT( dYdu ) ) THEN ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Loop through input variables - do i = 1,size(p%Vars%u) + do i = 1, size(p%Vars%u) ! If variable is not for linearization or is extended, skip if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle @@ -10683,14 +10594,12 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) - call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp); if (Failed()) return ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) - call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn); if (Failed()) return ! Get partial derivative via central difference call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdu(:,k)) @@ -10700,27 +10609,17 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Extended: BlPitchComC is the sum of BlPitchCom across all blades dYdu(:,p%Vars%u(p%iBlPitchComCVar)%iLoc(1)) = sum(dYdu(:,p%Vars%u(p%iBlPitchCoModVarType)%iLoc), dim=2) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) END IF - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + IF ( PRESENT( dXdu ) ) THEN ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through input variables @@ -10735,17 +10634,17 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) - call ED_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xp) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, x_p, m%Vals%xp) ! Calculate negative perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) - call ED_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xn) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, x_p, m%Vals%xn) ! Get partial derivative via central difference - call MV_ComputeCentralDiff(p%Vars%x, p%Vars%u(i)%Perturb, m%Vals%xp, m%Vals%xn, dXdu(:,k)) + dXdu(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki*p%Vars%u(i)%Perturb) end do end do @@ -10773,7 +10672,11 @@ subroutine cleanup() call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -10825,34 +10728,18 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, call ED_PackStateValues(p, x, m%Vals%x) ! make a copy of the continuous states to perturb - call ED_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - IF ( PRESENT( dYdx ) ) THEN + call ED_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + IF ( PRESENT( dYdx ) ) THEN ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! make a copy of outputs for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Loop through state variables do i = 1,size(p%Vars%x) @@ -10866,24 +10753,18 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) - call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp); if (Failed()) return ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) - call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn); if (Failed()) return ! Get partial derivative via central difference call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdx(:,k)) end do end do - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more END IF @@ -10894,12 +10775,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dXdx if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! Loop through state variables @@ -10914,17 +10790,17 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) - call ED_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xp) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, x_p, m%Vals%xp) ! Calculate negative perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) - call ED_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2, m%Vals%xn) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackStateValues(p, x_p, m%Vals%xn) ! Get partial derivative via central difference - call MV_ComputeCentralDiff(p%Vars%x, p%Vars%x(i)%Perturb, m%Vals%xp, m%Vals%xn, dXdx(:,k)) + dXdx(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do @@ -10948,7 +10824,11 @@ subroutine cleanup() call ED_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) m%IgnoreMod = .false. end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function END SUBROUTINE ED_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -11215,6 +11095,104 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, END SUBROUTINE ED_GetOP !---------------------------------------------------------------------------------------------------------------------------------- +subroutine ED_PackStateValues(p, x, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + ary(p%Vars%x(i)%iLoc) = x%QT(p%Vars%x(i)%iUsr) + case (VF_TransVel, VF_AngularVel) + ary(p%Vars%x(i)%iLoc) = x%QDT(p%Vars%x(i)%iUsr) + end select + end do +end subroutine + +subroutine ED_UnpackStateValues(p, ary, x) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc) + case (VF_TransVel, VF_AngularVel) + x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc) + end select + end do +end subroutine + +subroutine ED_PackInputValues(p, u, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_InputType), intent(in) :: u + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_PackMesh(p%Vars%u, iv, u%BladePtLoads(i), ary) + end do + end if + call MV_PackMesh(p%Vars%u, iv, u%PlatformPtMesh, ary) + call MV_PackMesh(p%Vars%u, iv, u%TowerPtLoads, ary) + call MV_PackMesh(p%Vars%u, iv, u%HubPtLoad, ary) + call MV_PackMesh(p%Vars%u, iv, u%NacelleLoads, ary) + call MV_PackVar(p%Vars%u, iv, u%BlPitchCom, ary) + call MV_PackVar(p%Vars%u, iv, u%YawMom, ary) + call MV_PackVar(p%Vars%u, iv, u%GenTrq, ary) + call MV_PackVar(p%Vars%u, iv, u%BlPitchCom(1), ary) +end subroutine + +subroutine ED_UnpackInputValues(p, ary, u) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: iv, i + iv = 1 + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%BladePtLoads(i)) + end do + end if + call MV_UnpackMesh(p%Vars%u, iv, ary, u%PlatformPtMesh) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%TowerPtLoads) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%HubPtLoad) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%NacelleLoads) + call MV_UnpackVar(p%Vars%u, iv, ary, u%BlPitchCom) + call MV_UnpackVar(p%Vars%u, iv, ary, u%YawMom) + call MV_UnpackVar(p%Vars%u, iv, ary, u%GenTrq) +end subroutine + +subroutine ED_PackOutputValues(p, y, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + if (allocated(y%BladeLn2Mesh)) then + do i = 1, size(y%BladeLn2Mesh) + call MV_PackMesh(p%Vars%y, iv, y%BladeLn2Mesh(i), ary) + end do + end if + call MV_PackMesh(p%Vars%y, iv, y%PlatformPtMesh, ary) + call MV_PackMesh(p%Vars%y, iv, y%TowerLn2Mesh, ary) + call MV_PackMesh(p%Vars%y, iv, y%HubPtMotion, ary) + if (allocated(y%BladeRootMotion)) then + do i = 1, size(y%BladeRootMotion) + call MV_PackMesh(p%Vars%y, iv, y%BladeRootMotion(i), ary) + end do + end if + call MV_PackMesh(p%Vars%y, iv, y%NacelleMotion, ary) + call MV_PackVar(p%Vars%y, iv, y%Yaw, ary) + call MV_PackVar(p%Vars%y, iv, y%YawRate, ary) + call MV_PackVar(p%Vars%y, iv, y%HSS_Spd, ary) + do while (iv <= size(p%Vars%y)) + call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr(1)), ary) + end do +end subroutine END MODULE ElastoDyn !********************************************************************************************************************************** diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 2d74092f7d..f56bb2c209 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -56,7 +56,6 @@ typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" -typedef ^ InitOutputType ModValsType *Vals - - - "Module Values" # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -523,7 +522,7 @@ typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAP typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - -typedef ^ MiscVarType ModValsType &Vals - - "Values corresponding to module variables" +typedef ^ MiscVarType ModValsType Vals - - "Values corresponding to module variables" # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 7fe76490e2..93e9325fac 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -76,7 +76,6 @@ MODULE ElastoDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] - TYPE(ModValsType) , POINTER :: Vals => NULL() !< Module Values [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -532,7 +531,7 @@ MODULE ElastoDyn_Types 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 = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] - TYPE(ModValsType) , POINTER :: Vals => NULL() + TYPE(ModValsType) :: Vals END TYPE ED_MiscVarType ! ======================= ! ========= ED_ParameterType ======= @@ -1069,7 +1068,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%Vars => SrcInitOutputData%Vars - DstInitOutputData%Vals => SrcInitOutputData%Vals end subroutine subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1123,7 +1121,6 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%IsLoad_u) end if nullify(InitOutputData%Vars) - nullify(InitOutputData%Vals) end subroutine subroutine ED_PackInitOutput(Buf, Indata) @@ -1218,13 +1215,6 @@ subroutine ED_PackInitOutput(Buf, Indata) call NWTC_Library_PackModVarsType(Buf, InData%Vars) end if end if - call RegPack(Buf, associated(InData%Vals)) - if (associated(InData%Vals)) then - call RegPackPointer(Buf, c_loc(InData%Vals), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModValsType(Buf, InData%Vals) - end if - end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1467,26 +1457,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) else OutData%Vars => null() end if - if (associated(OutData%Vals)) deallocate(OutData%Vals) - 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%Vals) - else - allocate(OutData%Vals,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Vals) - call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals - end if - else - OutData%Vals => null() - end if end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -7613,18 +7583,9 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%QD2T = SrcMiscData%QD2T end if DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - if (associated(SrcMiscData%Vals)) then - if (.not. associated(DstMiscData%Vals)) then - allocate(DstMiscData%Vals, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vals.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -7661,19 +7622,14 @@ subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%QD2T)) then deallocate(MiscData%QD2T) end if - if (associated(MiscData%Vals)) then - call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - deallocate(MiscData%Vals) - MiscData%Vals => null() - end if + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ED_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackMisc' - logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call ED_PackCoordSys(Buf, InData%CoordSys) call ED_PackRtHndSide(Buf, InData%RtHS) @@ -7713,13 +7669,7 @@ subroutine ED_PackMisc(Buf, Indata) call RegPack(Buf, InData%QD2T) end if call RegPack(Buf, InData%IgnoreMod) - call RegPack(Buf, associated(InData%Vals)) - if (associated(InData%Vals)) then - call RegPackPointer(Buf, c_loc(InData%Vals), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModValsType(Buf, InData%Vals) - end if - end if + call NWTC_Library_PackModValsType(Buf, InData%Vals) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7730,8 +7680,6 @@ subroutine ED_UnPackMisc(Buf, OutData) integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx - type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call ED_UnpackCoordSys(Buf, OutData%CoordSys) ! CoordSys call ED_UnpackRtHndSide(Buf, OutData%RtHS) ! RtHS @@ -7835,26 +7783,7 @@ subroutine ED_UnPackMisc(Buf, OutData) end if call RegUnpack(Buf, OutData%IgnoreMod) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%Vals)) deallocate(OutData%Vals) - 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%Vals) - else - allocate(OutData%Vals,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Vals) - call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals - end if - else - OutData%Vals => null() - end if + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals end subroutine subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) From d5f229d481011f8b3f7c6188af9af1cc9d22e15f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 16 Aug 2023 00:45:12 +0000 Subject: [PATCH 10/61] Integrate BeamDyn for tight coupling --- modules/beamdyn/src/BeamDyn.f90 | 950 ++++++++++++----------- modules/beamdyn/src/BeamDyn_IO.f90 | 4 - modules/beamdyn/src/BeamDyn_Types.f90 | 100 ++- modules/beamdyn/src/Registry_BeamDyn.txt | 5 +- 4 files changed, 570 insertions(+), 489 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index d2354776ef..b99902253a 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -328,17 +328,18 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I InitOut%kp_total = InputFileData%kp_total !............................................................................................ - ! Initialize Jacobian: + ! Module Variables !............................................................................................ - if (InitInp%Linearize) then - call Init_Jacobian( p, u, y, MiscVar, InitOut, ErrStat2, ErrMsg2) + + call Init_ModuleVars(InitInp, u, p, y, MiscVar, InitOut, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - + !............................................................................................ + ! Summary and cleanup + !............................................................................................ + call Cleanup() - return CONTAINS SUBROUTINE Cleanup() if (allocated(GLL_nodes )) deallocate(GLL_nodes ) @@ -346,6 +347,211 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE BD_Init +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) + TYPE(BD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(BD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(BD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(BD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j, flags + REAL(R8Ki) :: MaxThrust, MaxTorque + CHARACTER(200) :: Describe + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Set flags to none, if rotating states is true, set flags to rotating states + flags = VF_None + if (p%RotStates) flags = VF_RotFrame + + ! Add translation displacement and orientation variables at blade nodes + ! Note: the first node is not included as it is a constraint state + do i = 2, p%node_total + Describe = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& + trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, Num=3, Flags=flags, & + iUsr=[i], & + Perturb=0.2_BDKi*D2R_D * p%blade_length, & + LinNames=[trim(Describe)//' translational displacement in X, m', & + trim(Describe)//' translational displacement in Y, m', & + trim(Describe)//' translational displacement in Z, m']) + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, Num=3, Flags=flags, & + iUsr=[i], & + Perturb=0.2_BDKi*D2R_D, & + LinNames=[trim(Describe)//' rotational displacement in X, rad', & + trim(Describe)//' rotational displacement in Y, rad', & + trim(Describe)//' rotational displacement in Z, rad']) + end do + ! Add translation velocity and angular velocity at blade nodes + do i = 2, p%node_total + Describe = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& + trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransVel, Num=3, Flags=flags, & + iUsr=[i], & + Perturb=0.2_BDKi*D2R_D * p%blade_length, & + LinNames=[trim(Describe)//' translational displacement in X, m/s', & + trim(Describe)//' translational displacement in Y, m/s', & + trim(Describe)//' translational displacement in Z, m/s']) + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_AngularVel, Num=3, Flags=flags, & + iUsr=[i], & + Perturb=0.2_BDKi*D2R_D, & + LinNames=[trim(Describe)//' rotational displacement in X, rad/s', & + trim(Describe)//' rotational displacement in Y, rad/s', & + trim(Describe)//' rotational displacement in Z, rad/s']) + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + MaxThrust = 170.0_R8Ki*p%blade_length**2 + MaxTorque = 14.0_R8Ki*p%blade_length**3 + + call MV_AddMeshVar(p%Vars%u, "RootMotion", MotionFields, & + Nodes=u%RootMotion%Nnodes, & + Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransDisp + 0.2_R8Ki*D2R_D, & ! VF_Orientation + 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransVel + 0.2_R8Ki*D2R_D, & ! VF_AngularVel + 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransAcc + 0.2_R8Ki*D2R_D]) ! VF_AngularAcc + call MV_AddMeshVar(p%Vars%u, "PointLoad", LoadFields, & + Nodes=u%PointLoad%Nnodes, & + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment + call MV_AddMeshVar(p%Vars%u, "DistrLoad", LoadFields, Flags=VF_Line, & + Nodes=u%DistrLoad%Nnodes, & + Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force + MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + call MV_AddMeshVar(p%Vars%y, 'ReactionForce', LoadFields, Nodes=y%ReactionForce%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'BladeMotion', MotionFields, Nodes=y%BldMotion%Nnodes) + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & + Num=1, & + Flags=OutParamFlags(p%OutParam(i)%Indx), & + iUsr=[i], & + LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & + Active=p%OutParam(i)%Indx > 0) + end do + do i = 1, p%BldNd_NumOuts + call MV_AddVar(p%Vars%y, 'Node'//p%BldNd_OutParam(i)%Name, VF_Scalar, & + Num=size(p%BldNd_BlOutNd), & + Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & + iUsr=[(j, j=1,size(p%BldNd_BlOutNd))] + p%NumOuts + (i-1)*size(p%BldNd_BlOutNd), & + LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & + Active=p%BldNd_OutParam(i)%Indx > 0) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + if (.not. InitInp%Linearize) return + + ! State Variables + call AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + InitOut%DerivOrder_x = 2 + do i = 1, size(p%Vars%x) + do j = 1, p%Vars%x(i)%NumLin + InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames + InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 + end do + end do + + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%NumLin + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + call AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%NumLin + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 + end do + end do + +contains + + pure integer(IntKi) function OutParamFlags(indx) + integer(IntKi), intent(in) :: indx + integer(IntKi), parameter :: GlobalFrameIndices(*) = [& + TipTVXg, TipTVYg, TipTVZg, TipRVXg, TipRVYg, TipRVZg, NTVg, NRVg] + if (any(GlobalFrameIndices == indx)) then + OutParamFlags = VF_None + else + OutParamFlags = VF_RotFrame + end if + end function + + pure integer(IntKi) function BldNd_OutParamFlags(ChannelName) + character(*), intent(in) :: ChannelName + integer(IntKi) :: k + ! Get index of last character in channel name + k = len_trim(ChannelName) + ! If last letter is uppercase or lowercase G, then frame is global + if (ChannelName(k:k) == 'G' .or. ChannelName(k:k) == 'g') then + BldNd_OutParamFlags = VF_None + else + BldNd_OutParamFlags = VF_RotFrame + end if + end function + + pure character(LinChanLen) function BldNd_LinChan(BldNd_OutParam, IdxNode) result(name) + type(OutParmType), intent(in) :: BldNd_OutParam + integer(IntKi), intent(in) :: IdxNode + write(name, '("N",I3.3,A,", ",A)') IdxNode, trim(BldNd_OutParam%Name), trim(BldNd_OutParam%Units) + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine computes the mass (p%Mass0_QP) and stiffness (p%Stif0_QP) matrices at the quadrature nodes. subroutine InitializeMassStiffnessMatrices(InputFileData,p,ErrStat, ErrMsg) @@ -957,7 +1163,6 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%RotStates = InputFileData%RotStates ! Rotate states in linearization? - p%RelStates = InputFileData%RelStates ! Define states relative to root motion in linearization? p%rhoinf = InputFileData%rhoinf ! Numerical damping coefficient: [0,1]. No numerical damping if rhoinf = 1; maximum numerical damping if rhoinf = 0. p%dt = InputFileData%DTBeam ! Time step size @@ -2131,6 +2336,8 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcContStateDeriv' + integer(IntKi) :: i, j + real(R8Ki) :: H(3,3), c0, c(3), vc, ct(3,3), cdot(3,1) ! Initialize ErrStat @@ -2179,11 +2386,26 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return + ! dxdt%q contains angular velocities in terms of WM parameters, convert these to rad/s + ! do i = 2, size(dxdt%q, 2) + ! c = dxdt%q(4:6, i) + ! c0 = 2.0_R8Ki - dot_product(c, c) + ! vc = 2.0_R8Ki / (4.0_R8Ki - c0) + ! ct = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3]) + ! H = 0.0_R8Ki + ! do j = 1,3 + ! H(j,j) = 1.0_R8Ki + ! end do + ! cdot(:,1) = dxdt%dqdt(4:6, i) + ! H = vc*(H + vc/2.0_R8Ki*ct + vc/8.0_R8Ki*matmul(ct, ct)) + ! dxdt%dqdt(4:6, i) = pack(matmul(H, cdot), .true.) + ! end do + ! now set the derivatives of the continuous states. ! I am a little concerned that W-M parameter derivatives are in the wrong units, but I think this is the same issue that is in the GA2 solve (the opposite direction) dxdt%q = dxdt%dqdt dxdt%dqdt = m%RHS - + ! constraint state (which is not necessary, but I'll just add it here anyway) dxdt%dqdt(1:3,1) = u%RootMotion%TranslationAcc(:,1) dxdt%dqdt(4:6,1) = u%RootMotion%RotationAcc( :,1) @@ -5781,7 +6003,7 @@ END SUBROUTINE PitchActuator_SetBC !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, StateRel_x, StateRel_xdot) +SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -5806,224 +6028,106 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRel_x(:,:) !< Matrix by which the displacement states are optionally converted relative to root - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRel_xdot(:,:) !< Matrix by which the velocity states are optionally converted relative to root - - ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - REAL(R8Ki) :: RotateStates(3,3) - REAL(R8Ki), ALLOCATABLE :: RelState_x(:,:) - REAL(R8Ki), ALLOCATABLE :: RelState_xdot(:,:) + TYPE(BD_OutputType) :: y_p + TYPE(BD_ContinuousStateType) :: x_p + TYPE(BD_InputType) :: u_perturb + INTEGER(IntKi) :: i, j, k + REAL(R8Ki) :: RotateStates(3,3) - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'BD_JacobianPInput' - + character(*), parameter :: RoutineName = 'BD_JacobianPInput' + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - - + ! get OP values here: - call BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if (Failed()) return ! make a copy of the inputs to perturb - call BD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call BD_CopyInput(u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - if (p%RelStates) then - if (.not. allocated(RelState_x)) then - call AllocAry(RelState_x, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'RelState_x', ErrStat2, ErrMsg2) ! 18=6 motion fields on mesh x 3 directions for each field - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - if (.not. allocated(RelState_xdot)) then - call AllocAry(RelState_xdot, size(RelState_x,1), size(RelState_x,2), 'RelState_xdot', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - call Compute_RelState_Matrix(p, u, x, RelState_x, RelState_xdot) - - if ( present(StateRel_x) ) then - if (.not. allocated(StateRel_x)) then - call AllocAry(StateRel_x, size(RelState_x,1), size(RelState_x,2), 'StateRel_x', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - StateRel_x = RelState_x - end if - if ( present(StateRel_xdot) ) then - if (.not. allocated(StateRel_xdot)) then - call AllocAry(StateRel_xdot, size(RelState_xdot,1), size(RelState_xdot,2), 'StateRel_xdot', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - StateRel_xdot = RelState_xdot - end if - else - if ( present(StateRel_x) ) then - if (allocated(StateRel_x)) deallocate(StateRel_x) - end if - if ( present(StateRel_xdot) ) then - if (allocated(StateRel_xdot)) deallocate(StateRel_xdot) - end if - end if - + ! Pack operating point input values for perturbations + call BD_PackInputValues(p, u, m%Vals%u) + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: ! allocate dYdu if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! compute y at u_op + delta_p u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! get u_op - delta_m u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute y at u_op - delta_m u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If variable is not for linearization or is extended, skip + if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%NumLin + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call BD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call BD_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackOutputValues(p, y_p, m%Vals%yp) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call BD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call BD_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackOutputValues(p, y_p, m%Vals%yn) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdu(:,k)) + end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx=m%lin_C ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dYdu = dYdu + matmul(m%lin_C, RelState_x) - end if - + END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) + ! Loop through input variables + do i = 1,size(p%Vars%u) - ! compute x at u_op + delta u - call BD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! compute x at u_op - delta u - call BD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) - + ! If extended linearization variable, skip + if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%NumLin + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call BD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call BD_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, x_p, m%Vals%xp) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call BD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call BD_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, x_p, m%Vals%xn) + + ! Get partial derivative via central difference + dXdu(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki*p%Vars%u(i)%Perturb) + end do end do call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dXdx=m%lin_A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dXdu = dXdu + matmul(m%lin_A, RelState_x) - RelState_xdot - end if if (p%RotStates) then RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) @@ -6045,14 +6149,13 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call cleanup() contains subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) call BD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - - if (allocated(RelState_x)) deallocate(RelState_x) - if (allocated(RelState_xdot)) deallocate(RelState_xdot) end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -6090,11 +6193,6 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! local variables - TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m - TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m - TYPE(BD_ContinuousStateType) :: x_perturb INTEGER(IntKi) :: i REAL(R8Ki) :: RotateStates(3,3) REAL(R8Ki) :: RotateStatesTranspose(3,3) @@ -6105,34 +6203,19 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdx ) .AND. PRESENT( dXdx )) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dYdx, dXdx) - ELSEIF ( PRESENT( dYdx ) ) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx=dYdx ) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dYdx=dYdx ) - ELSEIF ( PRESENT( dXdx ) ) THEN - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dXdx=dXdx) -! call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, LIN_X_CALLED_FIRST, ErrStat2, ErrMsg2, dXdx=dXdx) - END IF - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + ! Calculate Jacobian without rotation + call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx); if (Failed()) return + if (p%RotStates) then RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) RotateStatesTranspose = transpose( RotateStates ) if ( present(StateRotation) ) then if (.not. allocated(StateRotation)) then - call AllocAry(StateRotation, 3, 3, 'StateRotation', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(StateRotation, 3, 3, 'StateRotation', ErrStat2, ErrMsg2); if (Failed()) return end if StateRotation = RotateStates end if @@ -6142,30 +6225,27 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if end if - IF ( PRESENT( dYdx ) ) THEN + ! If states need to be rotated + if (p%RotStates) then - if (p%RotStates) then + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + IF (PRESENT(dYdx)) THEN do i=1,size(dYdx,2),3 - dYdx(:, i:i+2) = matmul( dYdx(:, i:i+2), RotateStatesTranspose ) + dYdx(:, i:i+2) = matmul(dYdx(:, i:i+2), RotateStatesTranspose) end do - end if - - END IF - - IF ( PRESENT( dXdx ) ) THEN + END IF ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - if (p%RotStates) then + IF (PRESENT(dXdx)) THEN do i=1,size(dXdx,1),3 - dXdx(i:i+2,:) = matmul( RotateStates, dXdx(i:i+2,:) ) + dXdx(i:i+2,:) = matmul(RotateStates, dXdx(i:i+2,:)) end do do i=1,size(dXdx,2),3 - dXdx(:, i:i+2) = matmul( dXdx(:, i:i+2), RotateStatesTranspose ) + dXdx(:, i:i+2) = matmul(dXdx(:, i:i+2), RotateStatesTranspose) end do - end if - - END IF + END IF + + end if IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) @@ -6175,17 +6255,11 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, if (allocated(dZdx)) deallocate(dZdx) END IF - call cleanup() - contains - subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE BD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -6219,12 +6293,9 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ! local variables TYPE(BD_OutputType) :: y_p - TYPE(BD_OutputType) :: y_m TYPE(BD_ContinuousStateType) :: x_p - TYPE(BD_ContinuousStateType) :: x_m TYPE(BD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k + INTEGER(IntKi) :: i, j, k INTEGER(IntKi) :: index INTEGER(IntKi) :: dof @@ -6238,155 +6309,102 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat = ErrID_None ErrMsg = '' + ! Pack operating point state values for perturbations + call BD_PackStateValues(p, x, m%Vals%x) + ! make a copy of the continuous states to perturb - call BD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call BD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - index = 1 - do k=1,2 - do i=2,p%node_total - do dof=1,p%dof_node - - ! get x_op + delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, 1, x_perturb, delta ) - - ! compute y at x_op + delta x - call BD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - + call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! get x_op - delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call BD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If variable is not for linearization or is extended, skip + if (iand(p%Vars%x(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdx(:,index) ) - - index = index+1 - end do + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%NumLin + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call BD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call BD_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackOutputValues(p, y_p, m%Vals%yp) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call BD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call BD_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackOutputValues(p, y_p, m%Vals%yn) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdx(:,k)) end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! allocate dXdu if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if - index = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=2,p%node_total - do dof=1,p%dof_node - - ! get x_op + delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, 1, x_perturb, delta ) - - ! compute x at x_op + delta x - call BD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get x_op - delta x - call BD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call perturb_x(p, k, i, dof, -1, x_perturb, delta ) - - ! compute x at x_op - delta x - call BD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - call Compute_dX( p, x_p, x_m, delta, dXdx(:,index) ) - - index = index+1 - end do + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If no-lin or extended linearization variable, skip + if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%Size + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call BD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call BD_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, x_p, m%Vals%xp) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call BD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call BD_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, x_p, m%Vals%xn) + + ! Get partial derivative via central difference + dXdx(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more END IF - call cleanup() contains subroutine cleanup() - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call BD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call BD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function END SUBROUTINE BD_JacobianPContState_noRotate !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -6551,150 +6569,59 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) - LOGICAL :: ReturnTrimOP + LOGICAL :: LocalTrimOP TYPE(BD_ContinuousStateType) :: dx ! derivative of continuous states at operating point ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + LocalTrimOP = .false. + if (present(NeedTrimOP)) LocalTrimOP = NeedTrimOP + IF ( PRESENT( u_op ) ) THEN - - nu = size(p%Jac_u_indx,1) + u%RootMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if - - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%RootMotion, u_op, index, FieldMask=FieldMask) - - call PackLoadMesh(u%PointLoad, u_op, index) - call PackLoadMesh(u%DistrLoad, u_op, index) - + call BD_PackInputValues(p, u, u_op) END IF - + ! Only the y operating points need to potentially return a smaller array than the "normal" call to this return. In the trim solution, we use a smaller array for y. IF ( PRESENT( y_op ) ) THEN - ! Only the y operating points need to potentially return a smaller array than the "normal" call to this return. In the trim solution, we use a smaller array for y. - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if - if (.not. allocated(y_op)) then - ny = p%Jac_ny + y%BldMotion%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - index = 1 - call PackLoadMesh(y%ReactionForce, y_op, index) - - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - - + call BD_PackOutputValues(p, y, y_op) END IF IF ( PRESENT( x_op ) ) THEN - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx * 2,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(x_op, p%Vars%Nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return end if - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - x_op(index) = x%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - x_op(index) = x%dqdt( dof, i ) - index = index+1 - end do - end do - + call BD_PackStateValues(p, x, x_op) END IF IF ( PRESENT( dx_op ) ) THEN - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(dx_op, p%Vars%Nx, 'dx_op', ErrStat2,ErrMsg2); if (Failed()) return end if - - call BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call BD_DestroyContState( dx, ErrStat2, ErrMsg2) - return - end if - - index = 1 - do i=2,p%node_total - do dof=1,p%dof_node - dx_op(index) = dx%q( dof, i ) - index = index+1 - end do - end do - - do i=2,p%node_total - do dof=1,p%dof_node - dx_op(index) = dx%dqdt( dof, i ) - index = index+1 - end do - end do - - call BD_DestroyContState( dx, ErrStat2, ErrMsg2) - + call BD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2); if (Failed()) return + call BD_PackStateValues(p, dx, dx_op) + call BD_DestroyContState(dx, ErrStat2, ErrMsg2); if (Failed()) return END IF IF ( PRESENT( xd_op ) ) THEN - END IF - IF ( PRESENT( z_op ) ) THEN ! this is a little weird, but seems to be how BD has implemented the first node in the continuous state array. + ! this is never used + IF ( PRESENT( z_op ) ) THEN if (.not. allocated(z_op)) then - call AllocAry(z_op, p%dof_node * 2,'z_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(z_op, p%dof_node * 2,'z_op',ErrStat2,ErrMsg2); if (Failed()) return end if index = 1 @@ -6710,6 +6637,11 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, END IF +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE BD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -6810,6 +6742,78 @@ END SUBROUTINE cleanup END SUBROUTINE BD_WriteMassStiffInFirstNodeFrame !---------------------------------------------------------------------------------------------------------------------------------- +subroutine BD_PackStateValues(p, x, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp) + Values(p%Vars%x(i)%iLoc) = x%q(1:3,p%Vars%x(i)%iUsr(1)) ! XYZ displacement + case (VF_TransVel) + Values(p%Vars%x(i)%iLoc) = x%dqdt(1:3,p%Vars%x(i)%iUsr(1)) ! XYZ velocity + case (VF_Orientation) + Values(p%Vars%x(i)%iLoc) = x%q(4:6,p%Vars%x(i)%iUsr(1)) ! WM parameters + case (VF_AngularVel) + Values(p%Vars%x(i)%iLoc) = x%dqdt(4:6,p%Vars%x(i)%iUsr(1)) ! Angular velocity + end select + end do +end subroutine + +subroutine BD_UnpackStateValues(p, Values, x) + type(BD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Values(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp) + x%q(1:3,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! XYZ displacement + case (VF_TransVel) + x%dqdt(1:3,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! XYZ velocity + case (VF_Orientation) + x%q(4:6,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! WM parameters + case (VF_AngularVel) + x%dqdt(4:6,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! Angular velocity + end select + end do +end subroutine + +subroutine BD_PackInputValues(p, u, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_InputType), intent(in) :: u + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: iv + iv = 1 + call MV_PackMesh(p%Vars%u, iv, u%RootMotion, Values) + call MV_PackMesh(p%Vars%u, iv, u%PointLoad, Values) + call MV_PackMesh(p%Vars%u, iv, u%DistrLoad, Values) +end subroutine + +subroutine BD_UnpackInputValues(p, Values, u) + type(BD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Values(:) + type(BD_InputType), intent(inout) :: u + integer(IntKi) :: iv + iv = 1 + call MV_UnpackMesh(p%Vars%u, iv, Values, u%RootMotion) + call MV_UnpackMesh(p%Vars%u, iv, Values, u%PointLoad) + call MV_UnpackMesh(p%Vars%u, iv, Values, u%DistrLoad) +end subroutine + +subroutine BD_PackOutputValues(p, y, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: iv + iv = 1 + call MV_PackMesh(p%Vars%y, iv, y%ReactionForce, Values) + call MV_PackMesh(p%Vars%y, iv, y%BldMotion, Values) ! TODO: Add TrimOP + do while (iv <= size(p%Vars%y)) + call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr), Values) + end do +end subroutine !----------------------------------------------------------------------------------------------------------------------------------- END MODULE BeamDyn diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index af3548c49e..fbc0be180a 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -756,10 +756,6 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF if (InputFileData%tngt_stf_fd) CALL WrScr( 'Using finite difference to compute tangent stiffness matrix'//NewLine ) - ! ! RelStates - Define states relative to root motion during linearization? (flag) [used only when linearizing] - !CALL ReadVar(UnIn,InputFile,InputFileData%RelStates,"RelStates", "Define states relative to root motion during linearization? (flag) [used only when linearizing]",ErrStat2,ErrMsg2,UnEc) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - InputFileData%RelStates = .false. ! this doesn't seem to be needed anymore (and I think there is a problem with using it in MBC3) Line = "" CALL ReadVar(UnIn, InputFile, Line, 'tngt_stf_comp','compare tangent stiffness using finite difference flag', ErrStat2, ErrMsg2, UnEc) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 226c4a5137..7f2296b79a 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -70,6 +70,7 @@ MODULE BeamDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE BD_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -109,7 +110,6 @@ MODULE BeamDyn_Types 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 = .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] [-] @@ -157,6 +157,7 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -236,7 +237,6 @@ MODULE BeamDyn_Types 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 ======= @@ -331,6 +331,7 @@ MODULE BeamDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LP_indx !< Index vector for LU [-] TYPE(BD_InputType) :: u !< Inputs converted to the internal BD coordinate system [-] TYPE(BD_InputType) :: u2 !< Inputs in the FAST coordinate system, possibly modified by pitch actuator [-] + TYPE(ModValsType) :: Vals !< Values corresponding to module variables [-] END TYPE BD_MiscVarType ! ======================= CONTAINS @@ -566,6 +567,7 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -612,12 +614,14 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if + nullify(InitOutputData%Vars) end subroutine subroutine BD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitOutput' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then @@ -676,6 +680,13 @@ subroutine BD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -686,6 +697,8 @@ subroutine BD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) @@ -844,6 +857,26 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -1064,7 +1097,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta 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 @@ -1177,7 +1209,6 @@ subroutine BD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%pitchC) call RegPack(Buf, InData%Echo) call RegPack(Buf, InData%RotStates) - call RegPack(Buf, InData%RelStates) call RegPack(Buf, InData%tngt_stf_fd) call RegPack(Buf, InData%tngt_stf_comp) call RegPack(Buf, InData%NNodeOuts) @@ -1284,8 +1315,6 @@ subroutine BD_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RotStates) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RelStates) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%tngt_stf_fd) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%tngt_stf_comp) @@ -1775,6 +1804,18 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%dt = SrcParamData%dt DstParamData%coef = SrcParamData%coef DstParamData%rhoinf = SrcParamData%rhoinf @@ -2172,7 +2213,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) 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) @@ -2186,6 +2226,12 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%uuN0)) then deallocate(ParamData%uuN0) end if @@ -2292,7 +2338,15 @@ subroutine BD_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackParam' integer(IntKi) :: i1, i2, i3, i4 integer(IntKi) :: LB(4), UB(4) + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, InData%dt) call RegPack(Buf, InData%coef) call RegPack(Buf, InData%rhoinf) @@ -2492,7 +2546,6 @@ subroutine BD_PackParam(Buf, Indata) call RegPack(Buf, InData%Jac_ny) call RegPack(Buf, InData%Jac_nx) call RegPack(Buf, InData%RotStates) - call RegPack(Buf, InData%RelStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2504,7 +2557,29 @@ subroutine BD_UnPackParam(Buf, OutData) integer(IntKi) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%coef) @@ -3000,8 +3075,6 @@ subroutine BD_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RotStates) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RelStates) - if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine BD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -4658,6 +4731,9 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -4773,6 +4849,8 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BD_PackMisc(Buf, Indata) @@ -4938,6 +5016,7 @@ subroutine BD_PackMisc(Buf, Indata) end if call BD_PackInput(Buf, InData%u) call BD_PackInput(Buf, InData%u2) + call NWTC_Library_PackModValsType(Buf, InData%Vals) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5378,6 +5457,7 @@ subroutine BD_UnPackMisc(Buf, OutData) end if call BD_UnpackInput(Buf, OutData%u) ! u call BD_UnpackInput(Buf, OutData%u2) ! u2 + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals end subroutine subroutine BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 419d06517d..56444a25ec 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -53,6 +53,7 @@ typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... Blade Input file data........................................................................ typedef ^ BladeInputData IntKi station_total - - - "Number of blade input stations" @@ -99,7 +100,6 @@ typedef ^ BD_InputFile ^ pitchC - - - "Pitch actuator dam #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ BD_InputFile Logical Echo - - - "Echo" - typedef ^ BD_InputFile Logical RotStates - .TRUE. - "Orient states in rotating frame during linearization? (flag)" - -typedef ^ BD_InputFile Logical RelStates - .FALSE. - "Define states relative to root motion during linearization? (flag)" - typedef ^ BD_InputFile Logical tngt_stf_fd - - - "Flag to compute tangent stifness matrix via finite difference" - typedef ^ BD_InputFile Logical tngt_stf_comp - - - "Flag to compare finite differenced and analytical tangent stifness" - typedef ^ BD_InputFile IntKi NNodeOuts - - - "Number of node outputs [0 - 9]" - @@ -162,6 +162,7 @@ typedef ^ ^ ^ mEta ::: - - "Center of ma # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" typedef ^ ParameterType DbKi dt - - - "module dt" s typedef ^ ParameterType DbKi coef {9} - - "GA2 Coefficient" - typedef ^ ParameterType DbKi rhoinf - - - "Numerical Damping Coefficient for GA2" @@ -248,7 +249,6 @@ typedef ^ ParameterType R8Ki dx {6} typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - -typedef ^ ParameterType Logical RelStates - - - "Define states relative to root motion during linearization? (flag)" - # ..... Inputs @@ -373,4 +373,5 @@ typedef ^ MiscVarType ^ LP_RHS_LU {:} - - "R typedef ^ MiscVarType IntKi LP_indx {:} - - "Index vector for LU" - typedef ^ MiscVarType BD_InputType u - - - "Inputs converted to the internal BD coordinate system" - typedef ^ MiscVarType BD_InputType u2 - - - "Inputs in the FAST coordinate system, possibly modified by pitch actuator" - +typedef ^ MiscVarType ModValsType Vals - - - "Values corresponding to module variables" From f475b54081aadea53a02eb4dfa1d731651d5902f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 16 Aug 2023 00:45:47 +0000 Subject: [PATCH 11/61] Expand tight coupling to include BeamDyn --- modules/openfast-library/CMakeLists.txt | 1 - modules/openfast-library/src/FAST_Eval.f90 | 1544 ++++++++++------- modules/openfast-library/src/FAST_Lin_TC.f90 | 41 +- .../openfast-library/src/FAST_Registry.txt | 34 +- modules/openfast-library/src/FAST_Subs_TC.f90 | 14 +- modules/openfast-library/src/FAST_Types.f90 | 481 ++++- modules/openfast-library/src/Solver.f90 | 1328 ++++++++------ 7 files changed, 2269 insertions(+), 1174 deletions(-) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index ef681f1d9c..52c0d06d04 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -63,7 +63,6 @@ target_link_libraries(openfast_prelib set(POSTLIB_SOURCES src/FAST_Mods.f90 - src/FAST_Subs.f90 src/FAST_Solver.f90 ) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 3f7e188643..8587d6ddb1 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -1,3 +1,26 @@ +!******************************************************************************* +! FAST_Solver.f90, FAST_Subs.f90, FAST_Lin.f90, FAST_Eval, and FAST_Mods.f90 +! make up the FAST glue code in the FAST Modularization Framework. +! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are drivers for this code. +!............................................................................... +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!******************************************************************************* +!> This module contains functions for calling module subroutines module FAST_Eval use FAST_Solver @@ -12,785 +35,1034 @@ module FAST_Eval implicit none -! Evaluate Module Flags -integer(IntKi), parameter :: EM_InitIO = 1, & - EM_ExtrapInterp = 2, & - EM_InputSolve = 4, & - EM_UpdateStates = 8, & - EM_CalcOutput = 16, & - EM_CalcContStateDeriv = 32, & - EM_JacobianPInput = 64, & - EM_JacobianPContState = 128, & - EM_SavePredStates = 256 +integer(IntKi), parameter :: IS_Option1 = 1, & + IS_Option2 = 2, & + IS_Residual = 4, & + IS_All = 255 contains -subroutine FAST_EvalModules(t_initial, n_t_global, ModOrder, Mods, this_state, EvalFlags, T, ErrStat, ErrMsg, & - x, dxdt, dYdx, dXdx, dYdu, dXdu) +subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) - integer(IntKi), intent(in) :: n_t_global !< Integer time step - integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate - type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules - integer(IntKi), intent(in) :: this_state !< State index - integer(IntKi), intent(in) :: EvalFlags !< Evaluation flags to control what to evaluate - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - real(R8Ki), optional, intent(in) :: x(:) - real(R8Ki), optional, intent(out) :: dxdt(:) - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) - - character(*), parameter :: RoutineName = 'EvaluateModules' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, iMod, iIns - real(DbKi) :: t_module ! Current simulation time for module - real(DbKi) :: t_global ! Simulation time for computing outputs - real(DbKi) :: t_global_next ! Simulation time for computing outputs - real(DbKi) :: this_time ! Time for calculating outputs (based on this_state) - integer(IntKi) :: j_ss ! substep loop counter - integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + character(*), parameter :: RoutineName = 'FAST_ExtrapInterp' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j ErrStat = ErrID_None ErrMsg = '' - ! Calculate global time and next global time - t_global = n_t_global*T%p_FAST%dt + t_initial - t_global_next = (n_t_global + 1)*T%p_FAST%dt + t_initial - - ! Set this_time based on state - ! TODO: figure out where to use each - select case (this_state) - case (STATE_CURR) - this_time = t_global - case (STATE_PRED) - this_time = t_global_next + ! Select based on module ID + select case (Mod%ID) + + case (Module_AD) + + call AD_Input_ExtrapInterp(T%AD%Input, T%AD%InputTimes, T%AD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%AD%InputTimes(j + 1) = T%AD%InputTimes(j) + end do + call AD_CopyInput(T%AD%u, T%AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%AD%InputTimes(1) = t_global_next + + case (Module_BD) + + call BD_Input_ExtrapInterp(T%BD%Input(:, Mod%Ins), T%BD%InputTimes(:, Mod%Ins), T%BD%u(Mod%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call BD_CopyInput(T%BD%Input(j, Mod%Ins), T%BD%Input(j + 1, Mod%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(j + 1, Mod%Ins) = T%BD%InputTimes(j, Mod%Ins) + end do + call BD_CopyInput(T%BD%u(Mod%Ins), T%BD%Input(1, Mod%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(1, Mod%Ins) = t_global_next + + case (Module_ED) + + call ED_Input_ExtrapInterp(T%ED%Input, T%ED%InputTimes, T%ED%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%ED%InputTimes(j + 1) = T%ED%InputTimes(j) + end do + call ED_CopyInput(T%ED%u, T%ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%ED%InputTimes(1) = t_global_next + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + + call InflowWind_Input_ExtrapInterp(T%IfW%Input, T%IfW%InputTimes, T%IfW%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%IfW%InputTimes(j + 1) = T%IfW%InputTimes(j) + end do + call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%IfW%InputTimes(1) = t_global_next + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) + case (Module_SrvD) + + call SrvD_Input_ExtrapInterp(T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes(j + 1) = T%SrvD%InputTimes(j) + end do + call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes(1) = t_global_next + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return end select - ! Loop through modules to calculate output and state derivatives - do i = 1, size(ModOrder) - - ! Get module index - iMod = ModOrder(i) - - ! Get module instance index - iIns = Mods(iMod)%Instance - - ! Select based on module ID - select case (Mods(iMod)%ID) - -!------------------------------------------------------------------------------- -! Module_AD -!------------------------------------------------------------------------------- - - case (Module_AD) - - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - call AD_Input_ExtrapInterp(T%AD%Input, T%AD%InputTimes, T%AD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 - call AD_CopyInput(T%AD%Input(j), T%AD%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%AD%InputTimes(j + 1) = T%AD%InputTimes(j) - end do - call AD_CopyInput(T%AD%u, T%AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%AD%InputTimes(1) = t_global_next - end if - - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - call AD_InputSolve_NoIfW(T%p_FAST, T%AD%Input(1), T%SrvD%y, T%ED%y, T%BD, T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return - call AD_InputSolve_IfW(T%p_FAST, T%AD%Input(1), T%IfW%y, T%OpFM%y, ErrStat2, ErrMsg2); if (Failed()) return - end if - - ! UpdateStates - if (iand(EM_UpdateStates, EvalFlags) > 0) then - call AD_CopyContState(T%AD%x(STATE_CURR), T%AD%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call AD_CopyDiscState(T%AD%xd(STATE_CURR), T%AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call AD_CopyConstrState(T%AD%z(STATE_CURR), T%AD%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call AD_CopyOtherState(T%AD%OtherSt(STATE_CURR), T%AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - do j_ss = 1, Mods(iMod)%SubSteps - n_t_module = n_t_global*Mods(iMod)%SubSteps + j_ss - 1 - t_module = n_t_module*Mods(iMod)%DT + t_initial - call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, T%AD%p, T%AD%x(STATE_PRED), & - T%AD%xd(STATE_PRED), T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), T%AD%m, ErrStat2, ErrMsg2); if (Failed()) return - end do - end if - - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - call AD_CalcOutput(this_time, T%AD%Input(1), T%AD%p, T%AD%x(this_state), T%AD%xd(this_state), T%AD%z(this_state), & - T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep); if (Failed()) return - end if - - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if - - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if - - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if - -!------------------------------------------------------------------------------- -! Module_BD -!------------------------------------------------------------------------------- - - case (Module_BD) - - ! InitIO - if (iand(EM_InitIO, EvalFlags) > 0) then - T%BD%InputTimes(:, iIns) = t_initial - T%p_FAST%dt*[(j, j=0, T%p_FAST%InterpOrder)] - do j = 2, T%p_FAST%InterpOrder + 1 - call BD_CopyInput(T%BD%Input(1, iIns), T%BD%Input(j, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call BD_CopyInput(T%BD%Input(1, iIns), T%BD%u(iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyContState(T%BD%x(STATE_CURR, iIns), T%BD%x(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyDiscState(T%BD%xd(STATE_CURR, iIns), T%BD%xd(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyConstrState(T%BD%z(STATE_CURR, iIns), T%BD%z(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyOtherState(T%BD%OtherSt(STATE_CURR, iIns), T%BD%OtherSt(STATE_PRED, iIns), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end if - - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - call BD_Input_ExtrapInterp(T%BD%Input(:, iIns), T%BD%InputTimes(:, iIns), T%BD%u(iIns), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 - call BD_CopyInput(T%BD%Input(j, iIns), T%BD%Input(j + 1, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(j + 1, iIns) = T%BD%InputTimes(j, iIns) - end do - call BD_CopyInput(T%BD%u(iIns), T%BD%Input(1, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(1, iIns) = t_global_next - end if - - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - call Transfer_ED_to_BD(T%ED%y, T%BD%Input(1, :), T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return - call BD_InputSolve(T%p_FAST, T%BD, T%AD%y, T%AD%Input(1), T%ED%y, T%SrvD%y, T%SrvD%Input(1), T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - call BD_CopyContState(T%BD%x(STATE_CURR, iIns), T%BD%x(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyDiscState(T%BD%xd(STATE_CURR, iIns), T%BD%xd(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyConstrState(T%BD%z(STATE_CURR, iIns), T%BD%z(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyOtherState(T%BD%OtherSt(STATE_CURR, iIns), T%BD%OtherSt(STATE_PRED, iIns), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - ! if (present(x)) call ED_UnpackStateValues(T%BD%p, x(T%BD%p%Vars%ix), T%BD%x(STATE_PRED)) - end if +subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Initial simulation time (almost always 0) + real(DbKi), intent(in) :: DT !< Glue code time step size + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - call BD_CalcOutput(this_time, T%BD%Input(iIns, 1), T%BD%p(iIns), T%BD%x(iIns, this_state), & - T%BD%xd(iIns, this_state), T%BD%z(iIns, this_state), T%BD%OtherSt(iIns, this_state), & - T%BD%y(iIns), T%BD%m(iIns), ErrStat2, ErrMsg2); if (Failed()) return - end if - - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - call BD_CalcContStateDeriv(this_time, T%BD%Input(iIns, 1), T%BD%p(iIns), T%BD%x(iIns, this_state), & - T%BD%xd(iIns, this_state), T%BD%z(iIns, this_state), T%BD%OtherSt(iIns, this_state), & - T%BD%m(iIns), T%BD%dxdt(iIns), ErrStat2, ErrMsg2); if (Failed()) return - ! if (present(dxdt)) dxdt(T%BD%p(iIns)%Vars%ixg) = T%BD%m(iIns)%Vals%dxdt - end if + character(*), parameter :: RoutineName = 'FAST_InitIO' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(DbKi) :: t_global_next ! Simulation time for computing outputs + integer(IntKi) :: j, k - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - ! call BD_JacobianPInput(this_time, T%BD%Input(1), T%BD%p, T%BD%x(this_state), T%BD%xd(this_state), & - ! T%BD%z(this_state), T%BD%OtherSt(this_state), T%BD%y, T%BD%m, & - ! ErrStat2, ErrMsg2, dYdu=T%BD%m%Vals%dYdu, dXdu=T%BD%m%Vals%dXdu); if (Failed()) return - ! if (present(dYdu)) dYdu(T%BD%p%Vars%iyg, T%BD%p%Vars%iug) = T%BD%m%Vals%dYdu - ! if (present(dXdu)) dXdu(T%BD%p%Vars%ixg, T%BD%p%Vars%iug) = T%BD%m%Vals%dXdu - end if + ErrStat = ErrID_None + ErrMsg = '' - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - ! call ED_JacobianPContState(this_time, T%BD%Input(1), T%BD%p, T%BD%x(this_state), T%BD%xd(this_state), & - ! T%BD%z(this_state), T%BD%OtherSt(this_state), T%BD%y, T%BD%m, & - ! ErrStat2, ErrMsg2, dYdx=T%BD%m%Vals%dYdx, dXdx=T%BD%m%Vals%dXdx); if (Failed()) return - ! if (present(dYdx)) dYdx(T%BD%p%Vars%iyg, T%BD%p%Vars%ixg) = T%BD%m%Vals%dYdx - ! if (present(dXdx)) dXdx(T%BD%p%Vars%ixg, T%BD%p%Vars%ixg) = T%BD%m%Vals%dXdx - end if + ! Copy state from current to predicted and initialze meshes + call FAST_CopyStates(Mod, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Select based on module ID + select case (Mod%ID) + +! case (Module_AD) + + case (Module_BD) + + T%BD%InputTimes(:, Mod%Ins) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call BD_CopyInput(T%BD%Input(1, Mod%Ins), T%BD%Input(k, Mod%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call BD_CopyInput(T%BD%Input(1, Mod%Ins), T%BD%u(Mod%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ED) + + T%ED%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call ED_CopyInput(T%ED%Input(1), T%ED%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) +! case (Module_SrvD) + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select -!------------------------------------------------------------------------------- -! Module_ED -!------------------------------------------------------------------------------- - - case (Module_ED) - - ! InitIO - MESH_NEWCOPY is used to create/initialize the meshes - if (iand(EM_InitIO, EvalFlags) > 0) then - T%ED%InputTimes = t_initial - T%p_FAST%dt*[(j, j=0, T%p_FAST%InterpOrder)] - do j = 2, T%p_FAST%InterpOrder + 1 - call ED_CopyInput(T%ED%Input(1), T%ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyContState(T%ED%x(STATE_CURR), T%ED%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyDiscState(T%ED%xd(STATE_CURR), T%ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyConstrState(T%ED%z(STATE_CURR), T%ED%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyOtherState(T%ED%OtherSt(STATE_CURR), T%ED%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - call ED_Input_ExtrapInterp(T%ED%Input, T%ED%InputTimes, T%ED%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 - call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%ED%InputTimes(j + 1) = T%ED%InputTimes(j) - end do - call ED_CopyInput(T%ED%u, T%ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%ED%InputTimes(1) = t_global_next - end if +subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) + integer(IntKi), intent(in) :: n_t_global !< Integer time step + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - call ED_InputSolve(T%p_FAST, T%ED%Input(1), T%ED%y, T%AD14%p, T%AD14%y, T%AD%y, T%SrvD%y, & - T%AD%Input(1), T%SrvD%Input(1), T%MeshMapData, ErrStat2, ErrMsg2); if (Failed()) return - end if + character(*), parameter :: RoutineName = 'FAST_UpdateStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + real(DbKi) :: t_module ! Current simulation time for module - ! UpdateStates (tight coupling - state from solver) - MESH_UPDATECOPY is used to only update the meshes - if (iand(EM_UpdateStates, EvalFlags) > 0) then - call ED_CopyContState(T%ED%x(STATE_CURR), T%ED%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyDiscState(T%ED%xd(STATE_CURR), T%ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyConstrState(T%ED%z(STATE_CURR), T%ED%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyOtherState(T%ED%OtherSt(STATE_CURR), T%ED%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - if (present(x)) call ED_UnpackStateValues(T%ED%p, x(T%ED%p%Vars%ixg), T%ED%x(STATE_PRED)) - end if + ErrStat = ErrID_None + ErrMsg = '' - ! SavePredStates - save predicted states to current states - if (iand(EM_SavePredStates, EvalFlags) > 0) then - call ED_CopyContState(T%ED%x(STATE_PRED), T%ED%x(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyDiscState(T%ED%xd(STATE_PRED), T%ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyConstrState(T%ED%z(STATE_PRED), T%ED%z(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call ED_CopyOtherState(T%ED%OtherSt(STATE_PRED), T%ED%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - end if + ! Copy from current to predicted state (MESH_UPDATECOPY) + call FAST_CopyStates(Mod, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Select based on module ID + select case (Mod%ID) + + case (Module_AD) + + do j_ss = 1, Mod%SubSteps + n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 + t_module = n_t_module*Mod%DT + t_initial + call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, T%AD%p, T%AD%x(STATE_PRED), & + T%AD%xd(STATE_PRED), T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), T%AD%m, ErrStat2, ErrMsg2); if (Failed()) return + end do + + case (Module_BD) + + ! No update states for tight coupling modules + + case (Module_ED) + + ! No update states for tight coupling modules + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + + do j_ss = 1, Mod%SubSteps + n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 + t_module = n_t_module*Mod%DT + t_initial + call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & + T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return + end do + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) + case (Module_SrvD) + + do j_ss = 1, Mod%SubSteps + n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 + t_module = n_t_module*Mod%DT + t_initial + call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & + T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + end do + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - call ED_CalcOutput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2); if (Failed()) return - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - call ED_CalcContStateDeriv(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%m, & - T%ED%dxdt, ErrStat2, ErrMsg2, dxdtarr=T%ED%m%Vals%dxdt); if (Failed()) return - if (present(dxdt)) dxdt(T%ED%p%Vars%ixg) = T%ED%m%Vals%dxdt - end if +subroutine FAST_InitMappings(Mappings, T, ErrStat, ErrMsg) + type(TC_MeshMapType), intent(inout) :: Mappings(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & - ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return - if (present(dYdu)) dYdu(T%ED%p%Vars%iyg, T%ED%p%Vars%iug) = T%ED%m%Vals%dYdu - if (present(dXdu)) dXdu(T%ED%p%Vars%ixg, T%ED%p%Vars%iug) = T%ED%m%Vals%dXdu - end if + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j + integer(IntKi) :: iiu, iiy - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & - ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return - if (present(dYdx)) dYdx(T%ED%p%Vars%iyg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dYdx - if (present(dXdx)) dXdx(T%ED%p%Vars%ixg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dXdx - end if + ErrStat = ErrID_None + ErrMsg = '' -!------------------------------------------------------------------------------- -! Module_ExtPtfm -!------------------------------------------------------------------------------- + ! Loop through mappings + do j = 1, size(Mappings) - case (Module_ExtPtfm) + ! Get output and input module instance indices + iiy = Mappings(j)%SrcModInst + iiu = Mappings(j)%DstModInst - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + ! Select by mapping key + select case (Mappings(j)%Key) - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + case ('ED BladeRoot -> BD RootMotion') + call MeshMapCreate(T%ED%y%BladeRootMotion(iiu), T%BD%Input(1, iiu)%RootMotion, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + case ('BD ReactionForce -> ED HubLoad') + call MeshMapCreate(T%BD%y(iiu)%ReactionForce, T%ED%Input(1)%HubPtLoad, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + ! Copy temporary mesh to transfer reaction force because actual mesh is needed to sum multiple forces + call MeshCopy(T%ED%Input(1)%HubPtLoad, Mappings(j)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Mappings(j)%Key, ErrStat, ErrMsg, RoutineName) + return + end select - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + end do - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if +subroutine FAST_InputSolve(Mod, Mappings, Dst, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(TC_MeshMapType), intent(inout) :: Mappings(:) + integer(IntKi), intent(in) :: Dst + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j, k + integer(IntKi) :: iiu, iiy + type(ED_InputType), pointer :: u_ED + type(BD_InputType), pointer :: u_BD -!------------------------------------------------------------------------------- -! Module_FEAM -!------------------------------------------------------------------------------- + ErrStat = ErrID_None + ErrMsg = '' - case (Module_FEAM) + ! Check that Dst is valid + if (Dst /= 1 .and. Dst /= 2) then + call SetErrStat(ErrID_Fatal, "Dst must be 1 or 2, given "//trim(Num2LStr(Dst)), ErrStat, ErrMsg, RoutineName) + return + end if - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + ! Initialize module values before transfering + select case (Mod%ID) - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + case (Module_BD) - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + select case (Dst) + case (1) + u_BD => T%BD%Input(1, Mod%Ins) + case (2) + u_BD => T%BD%u(Mod%Ins) + end select - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + u_BD%DistrLoad%Force = 0.0_ReKi + u_BD%DistrLoad%Moment = 0.0_ReKi - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + case (Module_ED) - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + select case (Dst) + case (1) + u_ED => T%ED%Input(1) + case (2) + u_ED => T%ED%u + end select - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + u_ED%TowerPtLoads%Force = 0.0_ReKi + u_ED%TowerPtLoads%Moment = 0.0_ReKi -!------------------------------------------------------------------------------- -! Module_HD -!------------------------------------------------------------------------------- + u_ED%NacelleLoads%Force = 0.0_ReKi + u_ED%NacelleLoads%Moment = 0.0_ReKi - case (Module_HD) + u_ED%TwrAddedMass = 0.0_ReKi + u_ED%PtfmAddedMass = 0.0_ReKi - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + u_ED%HubPtLoad%Force = 0.0_ReKi + u_ED%HubPtLoad%Moment = 0.0_ReKi - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + end select - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + ! Loop through mapping index array + do k = 1, size(Mod%iMapsOpt1) - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + associate (Map => Mappings(Mod%iMapsOpt1(k))) - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + ! Get source and destination module instances + iiy = Map%SrcModInst + iiu = Map%DstModInst - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Map%Key) - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + case ('ED BladeRoot -> BD RootMotion') -!------------------------------------------------------------------------------- -! Module_IceD -!------------------------------------------------------------------------------- + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(iiu), u_BD%RootMotion, Map%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - case (Module_IceD) + case ('BD ReactionForce -> ED HubLoad') - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + ! u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations + call Transfer_Point_to_Point(T%BD%y(iiy)%ReactionForce, Map%MeshTmp, Map%MeshMap, & + ErrStat2, ErrMsg2, T%BD%Input(1, iiy)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return + u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Map%MeshTmp%Force + u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Map%MeshTmp%Moment - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Map%Key, ErrStat, ErrMsg, RoutineName) + return + end select - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + end associate + end do - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if +subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMsg, dUdu, dUdy) + type(ModDataType), intent(in) :: ModData(:) !< Module data + integer(IntKi), intent(in) :: ModOrder(:) + type(TC_MeshMapType), intent(inout) :: Mappings(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), optional, intent(inout) :: dUdu(:, :), dUdy(:, :) + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j, k + integer(IntKi) :: iiu, iiy - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + ErrStat = ErrID_None + ErrMsg = '' - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + ! Loop through mapping array + do j = 1, size(Mappings) -!------------------------------------------------------------------------------- -! Module_IceF -!------------------------------------------------------------------------------- + ! If mapping input and output modules are not in module order array, cycle + if (all(Mappings(j)%DstModIdx /= ModOrder) .and. all(Mappings(j)%SrcModIdx /= ModOrder)) cycle - case (Module_IceF) + ! Get input/output module instances + iiu = Mappings(j)%DstModInst + iiy = Mappings(j)%SrcModInst - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Mappings(j)%Key) - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + case ('ED BladeRoot -> BD RootMotion') + call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(iiu), T%BD%Input(1, iiu)%RootMotion, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + case ('BD ReactionForce -> ED HubLoad') + call Linearize_Point_to_Point(T%BD%y(iiy)%ReactionForce, T%ED%u%HubPtLoad, Mappings(j)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, iiy)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return ! <- displaced positions for load calculations - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Mappings(j)%Key, ErrStat, ErrMsg, RoutineName) + return + end select - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + if (present(dUdu)) then + call dUduSetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) + end if + if (present(dUdy)) then + call dUdySetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) + end if - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + end do - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if +contains + subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) + type(TC_MeshMapType), intent(inout) :: M !< Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data + type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data + + ! Effect of input Translation Velocity on input Translation Displacement + if (allocated(MML%tv_uD)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%tv_uD, dUdu) + end if + + ! Effect of input Translation Acceleration on input Translation Displacement + if (allocated(MML%ta_uD)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%ta_uD, dUdu) + end if + + ! Effect of input Moments on input Translation Displacement + if (allocated(MML%M_uS)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%u([M%SrcDispVarIdx]), VF_TransDisp, -MML%M_uS, dUdu) + end if + end subroutine + + subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) + type(TC_MeshMapType), intent(inout) :: M !< Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data + type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data + + ! Load identity + if (allocated(MML%li)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Force, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%li, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Moment, -MML%li, dUdy) + end if + + ! Moment to Force + if (allocated(MML%m_f)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%m_f, dUdy) + end if + + ! Moment to output translation displacement + if (allocated(Mappings(j)%MeshMap%dM%m_uD)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) + end if + + ! Motion identity + if (allocated(MML%mi)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Orientation, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransVel, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransAcc, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%mi, dUdy) + end if + + ! Translation to Rotation + if (allocated(MML%fx_p)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%fx_p, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%fx_p, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%fx_p, dUdy) + end if + + ! Translation velocity to translation displacement + if (allocated(MML%tv_us)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%tv_us, dUdy) + end if + + ! Translation acceleration to translation displacement + if (allocated(MML%ta_us)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%ta_us, dUdy) + end if + + ! Translation acceleration to angular velocity + if (allocated(MML%ta_rv)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%ta_us, dUdy) + end if + end subroutine + + subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) + type(ModVarType), intent(in) :: RowVars(:), ColVars(:) + integer(IntKi), intent(in) :: RowField, ColField + real(R8Ki), intent(in) :: Loc(:, :) + real(R8Ki), intent(inout) :: Gbl(:, :) + integer(IntKi) :: ir, ic, m, n, mSize, nSize + m = 1 + do ir = 1, size(RowVars) + if (RowVars(ir)%Field /= RowField) cycle + n = 1 + mSize = RowVars(ir)%Size + do ic = 1, size(ColVars) + if (ColVars(ic)%Field /= ColField) cycle + nSize = ColVars(ic)%Size + Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) = Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) + & + Loc(m:m + mSize - 1, n:n + nSize - 1) + ! write (*, *) 'Rows = ', RowVars(ir)%iGblSol + ! write (*, *) 'Cols = ', ColVars(ic)%iGblSol + ! write (*, *) 'Shape = ', mSize, nSize + ! write (*, '(A,*(ES14.5))') 'Values = ', Loc(m:m + mSize - 1, n:n + nSize - 1) + n = n + nSize + end do + m = m + mSize + end do + end subroutine + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine -!------------------------------------------------------------------------------- -! Module_IfW -!------------------------------------------------------------------------------- - - case (Module_IfW) - - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - call InflowWind_Input_ExtrapInterp(T%IfW%Input, T%IfW%InputTimes, T%IfW%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 - call InflowWind_CopyInput(T%IfW%Input(j), T%IfW%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%IfW%InputTimes(j + 1) = T%IfW%InputTimes(j) - end do - call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%IfW%InputTimes(1) = t_global_next - end if +subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + character(*), parameter :: RoutineName = 'FAST_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j + integer(IntKi) :: j_ss ! substep loop counter - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - call InflowWind_CopyContState(T%IfW%x(STATE_CURR), T%IfW%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call InflowWind_CopyDiscState(T%IfW%xd(STATE_CURR), T%IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call InflowWind_CopyConstrState(T%IfW%z(STATE_CURR), T%IfW%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call InflowWind_CopyOtherState(T%IfW%OtherSt(STATE_CURR), T%IfW%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - do j_ss = 1, Mods(iMod)%SubSteps - n_t_module = n_t_global*Mods(iMod)%SubSteps + j_ss - 1 - t_module = n_t_module*Mods(iMod)%DT + t_initial - call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & - T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return - end do - end if + ErrStat = ErrID_None + ErrMsg = '' - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + ! Select based on module ID + select case (Mod%ID) - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + case (Module_AD) - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + call AD_CalcOutput(this_time, T%AD%Input(1), T%AD%p, T%AD%x(this_state), T%AD%xd(this_state), T%AD%z(this_state), & + T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep); if (Failed()) return - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + case (Module_BD) -!------------------------------------------------------------------------------- -! Module_MAP -!------------------------------------------------------------------------------- + call BD_CalcOutput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & + T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & + T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return - case (Module_MAP) + case (Module_ED) - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + call ED_CalcOutput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2); if (Failed()) return - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) + case (Module_SrvD) - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + call SrvD_CalcOutput(this_time, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(this_state), T%SrvD%xd(this_state), T%SrvD%z(this_state), & + T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if +subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMsg, dxdt) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), optional, intent(out) :: dxdt(:) - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 -!------------------------------------------------------------------------------- -! Module_MD -!------------------------------------------------------------------------------- + ErrStat = ErrID_None + ErrMsg = '' - case (Module_MD) + ! Select based on module ID + select case (Mod%ID) + +! case (Module_AD) + + case (Module_BD) + + call BD_CalcContStateDeriv(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & + T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & + T%BD%m(Mod%Ins), T%BD%dxdt(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return + if (present(dxdt)) then + call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%dxdt(Mod%Ins), T%BD%m(Mod%Ins)%Vals%dxdt) + call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%dxdt, dxdt) + end if + + case (Module_ED) + + call ED_CalcContStateDeriv(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%m, & + T%ED%dxdt, ErrStat2, ErrMsg2); if (Failed()) return + if (present(dxdt)) then + call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) + call XferLocToGbl1D(Mod%ixs, T%ED%m%Vals%dxdt, dxdt) + end if + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) +! case (Module_SrvD) + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if +subroutine FAST_CalcJacobian(Mod, this_time, this_state, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: this_state !< State + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j_ss ! substep loop counter - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + ErrStat = ErrID_None + ErrMsg = '' - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + ! Select based on module ID + select case (Mod%ID) + +! case (Module_AD) + + case (Module_BD) + + call BD_JacobianPInput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & + T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & + ErrStat2, ErrMsg2, dYdu=T%BD%m(Mod%Ins)%Vals%dYdu, dXdu=T%BD%m(Mod%Ins)%Vals%dXdu); if (Failed()) return + if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%BD%m(Mod%Ins)%Vals%dYdu, dYdu) + if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%BD%m(Mod%Ins)%Vals%dXdu, dXdu) + + call BD_JacobianPContState(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & + T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & + ErrStat2, ErrMsg2, dYdx=T%BD%m(Mod%Ins)%Vals%dYdx, dXdx=T%BD%m(Mod%Ins)%Vals%dXdx); if (Failed()) return + if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dYdx, dYdx) + if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dXdx, dXdx) + + case (Module_ED) + + call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return + if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%ED%m%Vals%dYdu, dYdu) + if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%ED%m%Vals%dXdu, dXdu) + + call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%ED%m%Vals%dYdx, dYdx) + if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%ED%m%Vals%dXdx, dXdx) + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) +! case (Module_SrvD) + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if +subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData(:) !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi) :: i + + ! Loop through modules in ModData and copy state from predicted to current with MESH_UPDATECOPY + do i = 1, size(ModData) + call FAST_CopyStates(ModData(i), T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + end do +end subroutine -!------------------------------------------------------------------------------- -! Module_OpFM -!------------------------------------------------------------------------------- +subroutine XferLocToGbl1D(Inds, Loc, Gbl) + integer(IntKi), intent(in) :: Inds(:, :) + real(R8Ki), intent(in) :: Loc(:) + real(R8Ki), intent(inout) :: Gbl(:) + Gbl(Inds(:, 2)) = Loc(Inds(:, 1)) +end subroutine - case (Module_OpFM) +subroutine XferGblToLoc1D(Inds, Gbl, Loc) + integer(IntKi), intent(in) :: Inds(:, :) + real(R8Ki), intent(in) :: Gbl(:) + real(R8Ki), intent(inout) :: Loc(:) + Loc(Inds(:, 1)) = Gbl(Inds(:, 2)) +end subroutine - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if +subroutine XferLocToGbl2D(RowInds, ColInds, Loc, Gbl) + integer(IntKi), intent(in) :: RowInds(:, :), ColInds(:, :) + real(R8Ki), intent(in) :: Loc(:, :) + real(R8Ki), intent(inout) :: Gbl(:, :) + Gbl(RowInds(:, 2), ColInds(:, 2)) = Loc(RowInds(:, 1), ColInds(:, 1)) +end subroutine - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if +subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(in) :: Src, Dst !< State indices + integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + character(*), parameter :: RoutineName = 'FAST_CopyStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + integer(IntKi) :: i, j + integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + real(DbKi) :: t_module ! Current simulation time for module - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + ErrStat = ErrID_None + ErrMsg = '' - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + ! Select based on module ID + select case (Mod%ID) + + case (Module_AD) + + call AD_CopyContState(T%AD%x(Src), T%AD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyDiscState(T%AD%xd(Src), T%AD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyConstrState(T%AD%z(Src), T%AD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call AD_CopyOtherState(T%AD%OtherSt(Src), T%AD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_BD) + + call BD_CopyContState(T%BD%x(Mod%Ins, Src), T%BD%x(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(Mod%Ins, Src), T%BD%xd(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(Mod%Ins, Src), T%BD%z(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(Mod%Ins, Src), T%BD%OtherSt(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + + case (Module_ED) + + call ED_CopyContState(T%ED%x(Src), T%ED%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(Src), T%ED%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(Src), T%ED%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(Src), T%ED%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) +! case (Module_SrvD) + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine -!------------------------------------------------------------------------------- -! Module_Orca -!------------------------------------------------------------------------------- +subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - case (Module_Orca) + character(*), parameter :: RoutineName = 'FAST_ResetRemapFlags' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: k - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + ErrStat = ErrID_None + ErrMsg = '' - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + ! Select based on module ID + select case (Mod%ID) + + case (Module_AD) + + if (T%AD%Input(1)%rotors(1)%HubMotion%Committed) then + T%AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .false. + T%AD%y%rotors(1)%HubLoad%RemapFlag = .false. + end if - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + if (T%AD%Input(1)%rotors(1)%TowerMotion%Committed) then + T%AD%Input(1)%rotors(1)%TowerMotion%RemapFlag = .false. - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then + if (T%AD%y%rotors(1)%TowerLoad%Committed) then + T%AD%y%rotors(1)%TowerLoad%RemapFlag = .false. end if + end if - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + if (T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) then + T%AD%Input(1)%rotors(1)%NacelleMotion%RemapFlag = .false. + T%AD%y%rotors(1)%NacelleLoad%RemapFlag = .false. + end if - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + if (T%AD%Input(1)%rotors(1)%TFinMotion%Committed) then + T%AD%Input(1)%rotors(1)%TFinMotion%RemapFlag = .false. + T%AD%y%rotors(1)%TFinLoad%RemapFlag = .false. + end if - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + do k = 1, size(T%AD%Input(1)%rotors(1)%BladeMotion) + T%AD%Input(1)%rotors(1)%BladeRootMotion(k)%RemapFlag = .false. + T%AD%Input(1)%rotors(1)%BladeMotion(k)%RemapFlag = .false. + T%AD%y%rotors(1)%BladeLoad(k)%RemapFlag = .false. + end do -!------------------------------------------------------------------------------- -! Module_SD -!------------------------------------------------------------------------------- + case (Module_BD) - case (Module_SD) + T%BD%Input(1, Mod%Ins)%RootMotion%RemapFlag = .false. + T%BD%Input(1, Mod%Ins)%PointLoad%RemapFlag = .false. + T%BD%Input(1, Mod%Ins)%DistrLoad%RemapFlag = .false. + T%BD%Input(1, Mod%Ins)%HubMotion%RemapFlag = .false. - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + T%BD%y(Mod%Ins)%ReactionForce%RemapFlag = .false. + T%BD%y(Mod%Ins)%BldMotion%RemapFlag = .false. - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + case (Module_ED) - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + T%ED%Input(1)%PlatformPtMesh%RemapFlag = .false. + T%ED%y%PlatformPtMesh%RemapFlag = .false. + T%ED%Input(1)%TowerPtLoads%RemapFlag = .false. + T%ED%y%TowerLn2Mesh%RemapFlag = .false. + do K = 1, size(T%ED%y%BladeRootMotion) + T%ED%y%BladeRootMotion(K)%RemapFlag = .false. + end do + if (allocated(T%ED%Input(1)%BladePtLoads)) then + do K = 1, size(T%ED%Input(1)%BladePtLoads) + T%ED%Input(1)%BladePtLoads(K)%RemapFlag = .false. + T%ED%y%BladeLn2Mesh(K)%RemapFlag = .false. + end do + end if + T%ED%Input(1)%NacelleLoads%RemapFlag = .false. + T%ED%y%NacelleMotion%RemapFlag = .false. + T%ED%Input(1)%TFinCMLoads%RemapFlag = .false. + T%ED%y%TFinCMMotion%RemapFlag = .false. + T%ED%Input(1)%HubPtLoad%RemapFlag = .false. + T%ED%y%HubPtMotion%RemapFlag = .false. - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + case (Module_ExtPtfm) - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + if (T%ExtPtfm%Input(1)%PtfmMesh%Committed) then + T%ExtPtfm%Input(1)%PtfmMesh%RemapFlag = .false. + T%ExtPtfm%y%PtfmMesh%RemapFlag = .false. + end if - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + case (Module_FEAM) - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + T%FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .false. + T%FEAM%y%PtFairleadLoad%RemapFlag = .false. -!------------------------------------------------------------------------------- -! Module_SeaSt -!------------------------------------------------------------------------------- + case (Module_HD) - case (Module_SeaSt) + T%HD%Input(1)%PRPMesh%RemapFlag = .false. + if (T%HD%Input(1)%WAMITMesh%Committed) then + T%HD%Input(1)%WAMITMesh%RemapFlag = .false. + T%HD%y%WAMITMesh%RemapFlag = .false. + end if + if (T%HD%Input(1)%Morison%Mesh%Committed) then + T%HD%Input(1)%Morison%Mesh%RemapFlag = .false. + T%HD%y%Morison%Mesh%RemapFlag = .false. + end if - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - end if + case (Module_IceD) - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + if (T%IceD%Input(1, Mod%Ins)%PointMesh%Committed) then + T%IceD%Input(1, Mod%Ins)%PointMesh%RemapFlag = .false. + T%IceD%y(Mod%Ins)%PointMesh%RemapFlag = .false. + end if - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - end if + case (Module_IceF) - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - end if + if (T%IceF%Input(1)%iceMesh%Committed) then + T%IceF%Input(1)%iceMesh%RemapFlag = .false. + T%IceF%y%iceMesh%RemapFlag = .false. + end if - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if +! case (Module_IfW) - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + case (Module_MAP) - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. + T%MAP%y%PtFairleadLoad%RemapFlag = .false. -!------------------------------------------------------------------------------- -! Module_SrvD -!------------------------------------------------------------------------------- - - case (Module_SrvD) - - ! ExtrapInterp - if (iand(EM_ExtrapInterp, EvalFlags) > 0) then - call SrvD_Input_ExtrapInterp(T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return - do j = T%p_FAST%InterpOrder, 1, -1 - call SrvD_CopyInput(T%SrvD%Input(j), T%SrvD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%SrvD%InputTimes(j + 1) = T%SrvD%InputTimes(j) - end do - call SrvD_CopyInput(T%SrvD%u, T%SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - T%SrvD%InputTimes(1) = t_global_next - end if + case (Module_MD) - ! InputSolve - if (iand(EM_InputSolve, EvalFlags) > 0) then - end if + T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. + T%MD%y%CoupledLoads(1)%RemapFlag = .false. - ! UpdateStates (tight coupling - state from solver) - if (iand(EM_UpdateStates, EvalFlags) > 0) then - call SrvD_CopyContState(T%SrvD%x(STATE_CURR), T%SrvD%x(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call SrvD_CopyDiscState(T%SrvD%xd(STATE_CURR), T%SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call SrvD_CopyConstrState(T%SrvD%z(STATE_CURR), T%SrvD%z(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - call SrvD_CopyOtherState(T%SrvD%OtherSt(STATE_CURR), T%SrvD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - do j_ss = 1, Mods(iMod)%SubSteps - n_t_module = n_t_global*Mods(iMod)%SubSteps + j_ss - 1 - t_module = n_t_module*Mods(iMod)%DT + t_initial - call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & - T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return - if (ErrStat >= AbortErrLev) return - end do - end if +! case (Module_OpFM) - ! CalcOutput - if (iand(EM_CalcOutput, EvalFlags) > 0) then - call SrvD_CalcOutput(this_time, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(this_state), T%SrvD%xd(this_state), T%SrvD%z(this_state), & - T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return - end if + case (Module_Orca) - ! CalcContStateDeriv - if (iand(EM_CalcContStateDeriv, EvalFlags) > 0) then - end if + T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. + T%Orca%y%PtfmMesh%RemapFlag = .false. - ! JacobianPInput - if (iand(EM_JacobianPInput, EvalFlags) > 0) then - end if + case (Module_SD) - ! JacobianPContState - if (iand(EM_JacobianPContState, EvalFlags) > 0) then - end if + if (T%SD%Input(1)%TPMesh%Committed) then + T%SD%Input(1)%TPMesh%RemapFlag = .false. + T%SD%y%Y1Mesh%RemapFlag = .false. + end if -!------------------------------------------------------------------------------- -! Unknown module -!------------------------------------------------------------------------------- + if (T%SD%Input(1)%LMesh%Committed) then + T%SD%Input(1)%LMesh%RemapFlag = .false. + T%SD%y%Y2Mesh%RemapFlag = .false. + T%SD%y%Y3Mesh%RemapFlag = .false. + end if - case default +! case (Module_SeaSt) - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mods(iMod)%ID)), ErrStat, ErrMsg, RoutineName) +! case (Module_SrvD) - end select - end do + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select contains - function Failed() - logical :: Failed + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function diff --git a/modules/openfast-library/src/FAST_Lin_TC.f90 b/modules/openfast-library/src/FAST_Lin_TC.f90 index fef1ba292e..5cb0f73216 100644 --- a/modules/openfast-library/src/FAST_Lin_TC.f90 +++ b/modules/openfast-library/src/FAST_Lin_TC.f90 @@ -719,9 +719,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ! get the jacobians call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & - StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & - StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & @@ -1423,10 +1421,6 @@ SUBROUTINE WrLinFile_txt_End(Un, p_FAST, LinData) ! StateRotation matrix if (allocated(LinData%StateRotation)) call WrPartialMatrix( LinData%StateRotation, Un, p_FAST%OutFmt, 'StateRotation' ) - ! RelState matrices - if (allocated(LinData%StateRel_x)) call WrPartialMatrix( LinData%StateRel_x, Un, p_FAST%OutFmt, 'State_Rel_x' ) - if (allocated(LinData%StateRel_xdot)) call WrPartialMatrix( LinData%StateRel_xdot, Un, p_FAST%OutFmt, 'State_Rel_xdot' ) - close(Un) Un = -1 @@ -1499,28 +1493,21 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d if (present(rotFrame)) RotatingCol = rotFrame(i) if (index(names(i), ' orientation angle, node ') > 0 ) then ! make sure this matches what is written in PackMotionMesh_Names() - if (names(i)(1:2) == "ED") then - if (UseThisCol) then - if (index(names(i), 'X orientation') > 0) then - j = 1 - else if (index(names(i), 'Y orientation') > 0) then - j = 2 - else if (index(names(i), 'Z orientation') > 0) then - j = 3 - end if - DCM = wm_to_dcm(op(i_op-j+1:i_op-j+3)) - WRITE(Un, FmtOrient) i_print, DCM(j,1), DCM(j,2), DCM(j,3), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] - i_print = i_print + 1 - end if - i_op = i_op + 1 - else - if (UseThisCol) then - WRITE(Un, FmtOrient) i_print, op(i_op), op(i_op+1), op(i_op+2), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] - i_print = i_print + 1 + + if (UseThisCol) then + if (index(names(i), 'X orientation') > 0) then + j = 1 + else if (index(names(i), 'Y orientation') > 0) then + j = 2 + else if (index(names(i), 'Z orientation') > 0) then + j = 3 end if - i_op = i_op + 3 + DCM = wm_to_dcm(op(i_op-j+1:i_op-j+3)) + WRITE(Un, FmtOrient) i_print, DCM(j,1), DCM(j,2), DCM(j,3), RotatingCol, DerivOrdCol, trim(names(i)) !//' [OP is a row of the DCM] + i_print = i_print + 1 end if - + i_op = i_op + 1 + else if (UseThisCol) then if (UseDerivNames) then diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index a9a2c6fdba..cec2504415 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -90,6 +90,26 @@ typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - # ..... Tight Coupling Generalized Alpha Solver Data ............. +# Mapping Type +typedef ^ TC_MeshMapType character(VarNameLen) Key - - - "Mapping Key" - +typedef ^ ^ character(VarNameLen) SrcMeshName - - - "source mesh name" - +typedef ^ ^ character(VarNameLen) DstMeshName - - - "destination mesh name" - +typedef ^ ^ character(VarNameLen) SrcDispMeshName - '' - "source displacement mesh name [if IsLoad=true]" - +typedef ^ ^ character(VarNameLen) DstDispMeshName - '' - "destination displacement mesh name [if IsLoad=true]" - +typedef ^ ^ IntKi SrcModID - - - "Output module ID" - +typedef ^ ^ IntKi DstModID - - - "Input module ID" - +typedef ^ ^ IntKi SrcModIdx - - - "Output module index in ModData array" - +typedef ^ ^ IntKi DstModIdx - - - "Input module index in ModData array" - +typedef ^ ^ IntKi SrcModInst - - - "Output module Instance" - +typedef ^ ^ IntKi DstModInst - - - "Input module Instance" - +typedef ^ ^ IntKi SrcVarIdx : - - "motion variable index" - +typedef ^ ^ IntKi DstVarIdx : - - "motion variable index" - +typedef ^ ^ IntKi SrcDispVarIdx - - - "source displacement var index [if IsLoad=true]" - +typedef ^ ^ IntKi DstDispVarIdx - - - "destination displacement var index [if IsLoad=true]" - +typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - +typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from output variable to input variable" - +typedef ^ ^ logical IsLoad - - - "Flag indicating if this is a load or motion mapping" - + # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - typedef ^ ^ R8Ki ConvTol - - - "Solution convergence tolerance" - @@ -111,7 +131,8 @@ typedef ^ ^ IntKi iUTight : - - typedef ^ ^ IntKi iUOpt1 : - - "" - typedef ^ ^ IntKi iyTight : - - "" - typedef ^ ^ IntKi iyOpt1 : - - "" - -typedef ^ ^ IntKi ixqd :: - - "" - +typedef ^ ^ IntKi ixqd :: - - "" - +typedef ^ ^ IntKi iuLoad : - - "Indices of u load variables" - typedef ^ ^ IntKi iJX2 : - - "Indices of Jacobian q variables" - typedef ^ ^ IntKi iJT : - - "Indices of Jacobian tight coupling variables" - typedef ^ ^ IntKi iJ1 : - - "Indices of Jacobian option 1 variables" - @@ -138,15 +159,22 @@ typedef ^ ^ R8Ki dXdx :: - - typedef ^ ^ R8Ki dXdu :: - - "" - typedef ^ ^ R8Ki dUdu :: - - "" - typedef ^ ^ R8Ki dUdy :: - - "" - +typedef ^ ^ R8Ki GinvdUdu :: - - "" - +typedef ^ ^ R8Ki dUdyHat :: - - "" - typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - typedef ^ ^ R8Ki Jac :: - - "" - typedef ^ ^ IntKi IPIV : - - "" - +typedef ^ ^ IntKi IPIV2 : - - "" - typedef ^ ^ IntKi IterTotal - 0 - "" - -typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - -typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - +typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - +typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - typedef ^ ^ R8Ki dq :: - - "Change in q" - typedef ^ ^ R8Ki dx : - - "Change in x" - typedef ^ ^ R8Ki du : - - "" - +typedef ^ ^ R8Ki UDiff : - - "" - +typedef ^ ^ TC_MeshMapType Mappings : - - "Array of mesh mappings in solver" - +typedef ^ ^ IntKi DebugUnit - - - "Unit number to write debug info" - # ..... FAST_ParameterType data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index 958e7ee227..b706f0cb30 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -285,16 +285,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) end if + ! Add module to array of modules + call MV_AddModule(m_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + Init%OutData_ED%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF NumBl = Init%OutData_ED%NumBl - - ! Add module to array of modules - call MV_AddModule(m_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), & - Init%OutData_ED%Vars, Init%OutData_ED%Vals) if (p_FAST%CalcSteady) then if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then @@ -327,6 +328,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, BD%xd( p_FAST%nBeams,2), & BD%z( p_FAST%nBeams,2), & BD%OtherSt( p_FAST%nBeams,2), & + BD%dxdt( p_FAST%nBeams ), & BD%p( p_FAST%nBeams ), & BD%u( p_FAST%nBeams ), & BD%y( p_FAST%nBeams ), & @@ -407,6 +409,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) end if + + ! Add module instance to array of modules + call MV_AddModule(m_FAST%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END DO diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 4510c58295..51c9ae6512 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -109,6 +109,28 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_phase !< phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] END TYPE FAST_VTK_ModeShapeType ! ======================= +! ========= TC_MeshMapType ======= + TYPE, PUBLIC :: TC_MeshMapType + character(VarNameLen) :: Key !< Mapping Key [-] + character(VarNameLen) :: SrcMeshName !< source mesh name [-] + character(VarNameLen) :: DstMeshName !< destination mesh name [-] + character(VarNameLen) :: SrcDispMeshName = '' !< source displacement mesh name [if IsLoad=true] [-] + character(VarNameLen) :: DstDispMeshName = '' !< destination displacement mesh name [if IsLoad=true] [-] + INTEGER(IntKi) :: SrcModID = 0_IntKi !< Output module ID [-] + INTEGER(IntKi) :: DstModID = 0_IntKi !< Input module ID [-] + INTEGER(IntKi) :: SrcModIdx = 0_IntKi !< Output module index in ModData array [-] + INTEGER(IntKi) :: DstModIdx = 0_IntKi !< Input module index in ModData array [-] + INTEGER(IntKi) :: SrcModInst = 0_IntKi !< Output module Instance [-] + INTEGER(IntKi) :: DstModInst = 0_IntKi !< Input module Instance [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcVarIdx !< motion variable index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstVarIdx !< motion variable index [-] + INTEGER(IntKi) :: SrcDispVarIdx = 0_IntKi !< source displacement var index [if IsLoad=true] [-] + INTEGER(IntKi) :: DstDispVarIdx = 0_IntKi !< destination displacement var index [if IsLoad=true] [-] + TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] + TYPE(MeshMapType) :: MeshMap !< Mesh mapping from output variable to input variable [-] + LOGICAL :: IsLoad = .false. !< Flag indicating if this is a load or motion mapping [-] + END TYPE TC_MeshMapType +! ======================= ! ========= TC_ParameterType ======= TYPE, PUBLIC :: TC_ParameterType REAL(R8Ki) :: DT = 0.0_R8Ki !< solution time step [-] @@ -132,6 +154,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyTight !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyOpt1 !< [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iuLoad !< Indices of u load variables [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJX2 !< Indices of Jacobian q variables [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJT !< Indices of Jacobian tight coupling variables [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJ1 !< Indices of Jacobian option 1 variables [-] @@ -160,15 +183,22 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdu !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdy !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: GinvdUdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dUdyHat !< [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: XB !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: G !< Used to merge state matrices [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV2 !< [-] INTEGER(IntKi) :: IterTotal = 0 !< [-] INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dq !< Change in q [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] + TYPE(TC_MeshMapType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] + INTEGER(IntKi) :: DebugUnit = 0_IntKi !< Unit number to write debug info [-] END TYPE TC_MiscVarType ! ======================= ! ========= FAST_ParameterType ======= @@ -1476,6 +1506,187 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) end if end subroutine +subroutine FAST_CopyTC_MeshMapType(SrcTC_MeshMapTypeData, DstTC_MeshMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_MeshMapType), intent(inout) :: SrcTC_MeshMapTypeData + type(TC_MeshMapType), intent(inout) :: DstTC_MeshMapTypeData + 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 = 'FAST_CopyTC_MeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstTC_MeshMapTypeData%Key = SrcTC_MeshMapTypeData%Key + DstTC_MeshMapTypeData%SrcMeshName = SrcTC_MeshMapTypeData%SrcMeshName + DstTC_MeshMapTypeData%DstMeshName = SrcTC_MeshMapTypeData%DstMeshName + DstTC_MeshMapTypeData%SrcDispMeshName = SrcTC_MeshMapTypeData%SrcDispMeshName + DstTC_MeshMapTypeData%DstDispMeshName = SrcTC_MeshMapTypeData%DstDispMeshName + DstTC_MeshMapTypeData%SrcModID = SrcTC_MeshMapTypeData%SrcModID + DstTC_MeshMapTypeData%DstModID = SrcTC_MeshMapTypeData%DstModID + DstTC_MeshMapTypeData%SrcModIdx = SrcTC_MeshMapTypeData%SrcModIdx + DstTC_MeshMapTypeData%DstModIdx = SrcTC_MeshMapTypeData%DstModIdx + DstTC_MeshMapTypeData%SrcModInst = SrcTC_MeshMapTypeData%SrcModInst + DstTC_MeshMapTypeData%DstModInst = SrcTC_MeshMapTypeData%DstModInst + if (allocated(SrcTC_MeshMapTypeData%SrcVarIdx)) then + LB(1:1) = lbound(SrcTC_MeshMapTypeData%SrcVarIdx) + UB(1:1) = ubound(SrcTC_MeshMapTypeData%SrcVarIdx) + if (.not. allocated(DstTC_MeshMapTypeData%SrcVarIdx)) then + allocate(DstTC_MeshMapTypeData%SrcVarIdx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MeshMapTypeData%SrcVarIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MeshMapTypeData%SrcVarIdx = SrcTC_MeshMapTypeData%SrcVarIdx + end if + if (allocated(SrcTC_MeshMapTypeData%DstVarIdx)) then + LB(1:1) = lbound(SrcTC_MeshMapTypeData%DstVarIdx) + UB(1:1) = ubound(SrcTC_MeshMapTypeData%DstVarIdx) + if (.not. allocated(DstTC_MeshMapTypeData%DstVarIdx)) then + allocate(DstTC_MeshMapTypeData%DstVarIdx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MeshMapTypeData%DstVarIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MeshMapTypeData%DstVarIdx = SrcTC_MeshMapTypeData%DstVarIdx + end if + DstTC_MeshMapTypeData%SrcDispVarIdx = SrcTC_MeshMapTypeData%SrcDispVarIdx + DstTC_MeshMapTypeData%DstDispVarIdx = SrcTC_MeshMapTypeData%DstDispVarIdx + call MeshCopy(SrcTC_MeshMapTypeData%MeshTmp, DstTC_MeshMapTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcTC_MeshMapTypeData%MeshMap, DstTC_MeshMapTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstTC_MeshMapTypeData%IsLoad = SrcTC_MeshMapTypeData%IsLoad +end subroutine + +subroutine FAST_DestroyTC_MeshMapType(TC_MeshMapTypeData, ErrStat, ErrMsg) + type(TC_MeshMapType), intent(inout) :: TC_MeshMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyTC_MeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_MeshMapTypeData%SrcVarIdx)) then + deallocate(TC_MeshMapTypeData%SrcVarIdx) + end if + if (allocated(TC_MeshMapTypeData%DstVarIdx)) then + deallocate(TC_MeshMapTypeData%DstVarIdx) + end if + call MeshDestroy( TC_MeshMapTypeData%MeshTmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(TC_MeshMapTypeData%MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackTC_MeshMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TC_MeshMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_MeshMapType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Key) + call RegPack(Buf, InData%SrcMeshName) + call RegPack(Buf, InData%DstMeshName) + call RegPack(Buf, InData%SrcDispMeshName) + call RegPack(Buf, InData%DstDispMeshName) + call RegPack(Buf, InData%SrcModID) + call RegPack(Buf, InData%DstModID) + call RegPack(Buf, InData%SrcModIdx) + call RegPack(Buf, InData%DstModIdx) + call RegPack(Buf, InData%SrcModInst) + call RegPack(Buf, InData%DstModInst) + call RegPack(Buf, allocated(InData%SrcVarIdx)) + if (allocated(InData%SrcVarIdx)) then + call RegPackBounds(Buf, 1, lbound(InData%SrcVarIdx), ubound(InData%SrcVarIdx)) + call RegPack(Buf, InData%SrcVarIdx) + end if + call RegPack(Buf, allocated(InData%DstVarIdx)) + if (allocated(InData%DstVarIdx)) then + call RegPackBounds(Buf, 1, lbound(InData%DstVarIdx), ubound(InData%DstVarIdx)) + call RegPack(Buf, InData%DstVarIdx) + end if + call RegPack(Buf, InData%SrcDispVarIdx) + call RegPack(Buf, InData%DstDispVarIdx) + call MeshPack(Buf, InData%MeshTmp) + call NWTC_Library_PackMeshMapType(Buf, InData%MeshMap) + call RegPack(Buf, InData%IsLoad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTC_MeshMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TC_MeshMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_MeshMapType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Key) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcMeshName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstMeshName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcDispMeshName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstDispMeshName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcModID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstModID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcModIdx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstModIdx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcModInst) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstModInst) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SrcVarIdx)) deallocate(OutData%SrcVarIdx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SrcVarIdx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrcVarIdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SrcVarIdx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DstVarIdx)) deallocate(OutData%DstVarIdx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DstVarIdx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DstVarIdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DstVarIdx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SrcDispVarIdx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstDispVarIdx) + if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(Buf, OutData%MeshTmp) ! MeshTmp + call NWTC_Library_UnpackMeshMapType(Buf, OutData%MeshMap) ! MeshMap + call RegUnpack(Buf, OutData%IsLoad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: SrcTC_ParameterTypeData type(TC_ParameterType), intent(inout) :: DstTC_ParameterTypeData @@ -1585,6 +1796,18 @@ subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTyp end if DstTC_ParameterTypeData%ixqd = SrcTC_ParameterTypeData%ixqd end if + if (allocated(SrcTC_ParameterTypeData%iuLoad)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iuLoad) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iuLoad) + if (.not. allocated(DstTC_ParameterTypeData%iuLoad)) then + allocate(DstTC_ParameterTypeData%iuLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iuLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iuLoad = SrcTC_ParameterTypeData%iuLoad + end if if (allocated(SrcTC_ParameterTypeData%iJX2)) then LB(1:1) = lbound(SrcTC_ParameterTypeData%iJX2) UB(1:1) = ubound(SrcTC_ParameterTypeData%iJX2) @@ -1723,6 +1946,9 @@ subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) if (allocated(TC_ParameterTypeData%ixqd)) then deallocate(TC_ParameterTypeData%ixqd) end if + if (allocated(TC_ParameterTypeData%iuLoad)) then + deallocate(TC_ParameterTypeData%iuLoad) + end if if (allocated(TC_ParameterTypeData%iJX2)) then deallocate(TC_ParameterTypeData%iJX2) end if @@ -1806,6 +2032,11 @@ subroutine FAST_PackTC_ParameterType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%ixqd), ubound(InData%ixqd)) call RegPack(Buf, InData%ixqd) end if + call RegPack(Buf, allocated(InData%iuLoad)) + if (allocated(InData%iuLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%iuLoad), ubound(InData%iuLoad)) + call RegPack(Buf, InData%iuLoad) + end if call RegPack(Buf, allocated(InData%iJX2)) if (allocated(InData%iJX2)) then call RegPackBounds(Buf, 1, lbound(InData%iJX2), ubound(InData%iJX2)) @@ -1988,6 +2219,20 @@ subroutine FAST_UnPackTC_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%ixqd) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%iuLoad)) deallocate(OutData%iuLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iuLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iuLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iuLoad) + if (RegCheckErr(Buf, RoutineName)) return + end if if (allocated(OutData%iJX2)) deallocate(OutData%iJX2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2117,13 +2362,15 @@ subroutine FAST_UnPackTC_ParameterType(Buf, OutData) end subroutine subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) - type(TC_MiscVarType), intent(in) :: SrcTC_MiscVarTypeData + type(TC_MiscVarType), intent(inout) :: SrcTC_MiscVarTypeData type(TC_MiscVarType), intent(inout) :: DstTC_MiscVarTypeData 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_CopyTC_MiscVarType' ErrStat = ErrID_None ErrMsg = '' @@ -2307,6 +2554,30 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if DstTC_MiscVarTypeData%dUdy = SrcTC_MiscVarTypeData%dUdy end if + if (allocated(SrcTC_MiscVarTypeData%GinvdUdu)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%GinvdUdu) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%GinvdUdu) + if (.not. allocated(DstTC_MiscVarTypeData%GinvdUdu)) then + allocate(DstTC_MiscVarTypeData%GinvdUdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%GinvdUdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%GinvdUdu = SrcTC_MiscVarTypeData%GinvdUdu + end if + if (allocated(SrcTC_MiscVarTypeData%dUdyHat)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%dUdyHat) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%dUdyHat) + if (.not. allocated(DstTC_MiscVarTypeData%dUdyHat)) then + allocate(DstTC_MiscVarTypeData%dUdyHat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%dUdyHat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%dUdyHat = SrcTC_MiscVarTypeData%dUdyHat + end if if (allocated(SrcTC_MiscVarTypeData%XB)) then LB(1:2) = lbound(SrcTC_MiscVarTypeData%XB) UB(1:2) = ubound(SrcTC_MiscVarTypeData%XB) @@ -2319,6 +2590,18 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if DstTC_MiscVarTypeData%XB = SrcTC_MiscVarTypeData%XB end if + if (allocated(SrcTC_MiscVarTypeData%G)) then + LB(1:2) = lbound(SrcTC_MiscVarTypeData%G) + UB(1:2) = ubound(SrcTC_MiscVarTypeData%G) + if (.not. allocated(DstTC_MiscVarTypeData%G)) then + allocate(DstTC_MiscVarTypeData%G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%G = SrcTC_MiscVarTypeData%G + end if if (allocated(SrcTC_MiscVarTypeData%Jac)) then LB(1:2) = lbound(SrcTC_MiscVarTypeData%Jac) UB(1:2) = ubound(SrcTC_MiscVarTypeData%Jac) @@ -2343,6 +2626,18 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if DstTC_MiscVarTypeData%IPIV = SrcTC_MiscVarTypeData%IPIV end if + if (allocated(SrcTC_MiscVarTypeData%IPIV2)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%IPIV2) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%IPIV2) + if (.not. allocated(DstTC_MiscVarTypeData%IPIV2)) then + allocate(DstTC_MiscVarTypeData%IPIV2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%IPIV2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%IPIV2 = SrcTC_MiscVarTypeData%IPIV2 + end if DstTC_MiscVarTypeData%IterTotal = SrcTC_MiscVarTypeData%IterTotal DstTC_MiscVarTypeData%IterUntilUJac = SrcTC_MiscVarTypeData%IterUntilUJac DstTC_MiscVarTypeData%StepsUntilUJac = SrcTC_MiscVarTypeData%StepsUntilUJac @@ -2382,12 +2677,45 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if DstTC_MiscVarTypeData%du = SrcTC_MiscVarTypeData%du end if + if (allocated(SrcTC_MiscVarTypeData%UDiff)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%UDiff) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%UDiff) + if (.not. allocated(DstTC_MiscVarTypeData%UDiff)) then + allocate(DstTC_MiscVarTypeData%UDiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%UDiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MiscVarTypeData%UDiff = SrcTC_MiscVarTypeData%UDiff + end if + if (allocated(SrcTC_MiscVarTypeData%Mappings)) then + LB(1:1) = lbound(SrcTC_MiscVarTypeData%Mappings) + UB(1:1) = ubound(SrcTC_MiscVarTypeData%Mappings) + if (.not. allocated(DstTC_MiscVarTypeData%Mappings)) then + allocate(DstTC_MiscVarTypeData%Mappings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%Mappings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyTC_MeshMapType(SrcTC_MiscVarTypeData%Mappings(i1), DstTC_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstTC_MiscVarTypeData%DebugUnit = SrcTC_MiscVarTypeData%DebugUnit end subroutine subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) type(TC_MiscVarType), intent(inout) :: TC_MiscVarTypeData 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_DestroyTC_MiscVarType' ErrStat = ErrID_None ErrMsg = '' @@ -2436,15 +2764,27 @@ subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) if (allocated(TC_MiscVarTypeData%dUdy)) then deallocate(TC_MiscVarTypeData%dUdy) end if + if (allocated(TC_MiscVarTypeData%GinvdUdu)) then + deallocate(TC_MiscVarTypeData%GinvdUdu) + end if + if (allocated(TC_MiscVarTypeData%dUdyHat)) then + deallocate(TC_MiscVarTypeData%dUdyHat) + end if if (allocated(TC_MiscVarTypeData%XB)) then deallocate(TC_MiscVarTypeData%XB) end if + if (allocated(TC_MiscVarTypeData%G)) then + deallocate(TC_MiscVarTypeData%G) + end if if (allocated(TC_MiscVarTypeData%Jac)) then deallocate(TC_MiscVarTypeData%Jac) end if if (allocated(TC_MiscVarTypeData%IPIV)) then deallocate(TC_MiscVarTypeData%IPIV) end if + if (allocated(TC_MiscVarTypeData%IPIV2)) then + deallocate(TC_MiscVarTypeData%IPIV2) + end if if (allocated(TC_MiscVarTypeData%dq)) then deallocate(TC_MiscVarTypeData%dq) end if @@ -2454,12 +2794,26 @@ subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) if (allocated(TC_MiscVarTypeData%du)) then deallocate(TC_MiscVarTypeData%du) end if + if (allocated(TC_MiscVarTypeData%UDiff)) then + deallocate(TC_MiscVarTypeData%UDiff) + end if + if (allocated(TC_MiscVarTypeData%Mappings)) then + LB(1:1) = lbound(TC_MiscVarTypeData%Mappings) + UB(1:1) = ubound(TC_MiscVarTypeData%Mappings) + do i1 = LB(1), UB(1) + call FAST_DestroyTC_MeshMapType(TC_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(TC_MiscVarTypeData%Mappings) + end if end subroutine subroutine FAST_PackTC_MiscVarType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TC_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackTC_MiscVarType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%q)) if (allocated(InData%q)) then @@ -2536,11 +2890,26 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%dUdy), ubound(InData%dUdy)) call RegPack(Buf, InData%dUdy) end if + call RegPack(Buf, allocated(InData%GinvdUdu)) + if (allocated(InData%GinvdUdu)) then + call RegPackBounds(Buf, 2, lbound(InData%GinvdUdu), ubound(InData%GinvdUdu)) + call RegPack(Buf, InData%GinvdUdu) + end if + call RegPack(Buf, allocated(InData%dUdyHat)) + if (allocated(InData%dUdyHat)) then + call RegPackBounds(Buf, 2, lbound(InData%dUdyHat), ubound(InData%dUdyHat)) + call RegPack(Buf, InData%dUdyHat) + end if call RegPack(Buf, allocated(InData%XB)) if (allocated(InData%XB)) then call RegPackBounds(Buf, 2, lbound(InData%XB), ubound(InData%XB)) call RegPack(Buf, InData%XB) end if + call RegPack(Buf, allocated(InData%G)) + if (allocated(InData%G)) then + call RegPackBounds(Buf, 2, lbound(InData%G), ubound(InData%G)) + call RegPack(Buf, InData%G) + end if call RegPack(Buf, allocated(InData%Jac)) if (allocated(InData%Jac)) then call RegPackBounds(Buf, 2, lbound(InData%Jac), ubound(InData%Jac)) @@ -2551,6 +2920,11 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%IPIV), ubound(InData%IPIV)) call RegPack(Buf, InData%IPIV) end if + call RegPack(Buf, allocated(InData%IPIV2)) + if (allocated(InData%IPIV2)) then + call RegPackBounds(Buf, 1, lbound(InData%IPIV2), ubound(InData%IPIV2)) + call RegPack(Buf, InData%IPIV2) + end if call RegPack(Buf, InData%IterTotal) call RegPack(Buf, InData%IterUntilUJac) call RegPack(Buf, InData%StepsUntilUJac) @@ -2569,6 +2943,21 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if + call RegPack(Buf, allocated(InData%UDiff)) + if (allocated(InData%UDiff)) then + call RegPackBounds(Buf, 1, lbound(InData%UDiff), ubound(InData%UDiff)) + call RegPack(Buf, InData%UDiff) + end if + call RegPack(Buf, allocated(InData%Mappings)) + if (allocated(InData%Mappings)) then + call RegPackBounds(Buf, 1, lbound(InData%Mappings), ubound(InData%Mappings)) + LB(1:1) = lbound(InData%Mappings) + UB(1:1) = ubound(InData%Mappings) + do i1 = LB(1), UB(1) + call FAST_PackTC_MeshMapType(Buf, InData%Mappings(i1)) + end do + end if + call RegPack(Buf, InData%DebugUnit) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2576,6 +2965,7 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(TC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackTC_MiscVarType' + integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -2790,6 +3180,34 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%dUdy) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%GinvdUdu)) deallocate(OutData%GinvdUdu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GinvdUdu(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GinvdUdu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GinvdUdu) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dUdyHat)) deallocate(OutData%dUdyHat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dUdyHat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dUdyHat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dUdyHat) + if (RegCheckErr(Buf, RoutineName)) return + end if if (allocated(OutData%XB)) deallocate(OutData%XB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2804,6 +3222,20 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%XB) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%G)) deallocate(OutData%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%G(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%G) + if (RegCheckErr(Buf, RoutineName)) return + end if if (allocated(OutData%Jac)) deallocate(OutData%Jac) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2832,6 +3264,20 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%IPIV) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%IPIV2)) deallocate(OutData%IPIV2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IPIV2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IPIV2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IPIV2) + if (RegCheckErr(Buf, RoutineName)) return + end if call RegUnpack(Buf, OutData%IterTotal) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%IterUntilUJac) @@ -2880,6 +3326,37 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%UDiff)) deallocate(OutData%UDiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UDiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UDiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UDiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mappings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mappings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackTC_MeshMapType(Buf, OutData%Mappings(i1)) ! Mappings + end do + end if + call RegUnpack(Buf, OutData%DebugUnit) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -15376,7 +15853,7 @@ subroutine FAST_UnPackExternInputType(Buf, OutData) end subroutine subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(FAST_MiscVarType), intent(in) :: SrcMiscData + type(FAST_MiscVarType), intent(inout) :: SrcMiscData type(FAST_MiscVarType), intent(inout) :: DstMiscData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 37960a7647..650717c8fc 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -32,6 +32,8 @@ module Solver XM_dYdu = 16, & XM_dXdu = 32 +integer(IntKi) :: munit + contains subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) @@ -47,56 +49,54 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 ! local error message integer(IntKi) :: i, j, k, n integer(IntKi) :: NumX, NumU, NumY, NumQ, NumJac - integer(IntKi), allocatable :: iq(:), modIDs(:) + integer(IntKi), allocatable :: iq(:), modIDs(:), vec1(:), vec2(:) logical :: isLoad logical, allocatable :: isLoadTight(:), isLoadOption1(:) + type(TC_MeshMapType) :: MeshMap !---------------------------------------------------------------------------- - ! Calculate generalized alpha parameters + ! Module ordering for solve !---------------------------------------------------------------------------- - p%AccBlend = 1.0_R8Ki + ! Get array of module IDs + modIDs = [(ModData(i)%ID, i=1, size(ModData))] - p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) - p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) - p%Gamma = 0.5_ReKi - p%AlphaM + p%AlphaF - p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2/4.0_R8Ki + ! Ordering array for all modules + p%iModAll = [pack([(i, i=1, size(ModData))], ModIDs == Module_SrvD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_AD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & + pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] - p%C(1) = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) - p%C(2) = p%DT*p%Gamma*p%C(1) - p%C(3) = p%DT**2*p%Beta*p%C(1) + ! Ordering array for tight coupling modules + p%iModTC = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & + pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + + ! Ordering array for Option 2 solve + p%iModOpt2 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & + pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + + ! Ordering array for Option 1 solve + p%iModOpt1 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & + pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_SD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_ExtPtfm), & + pack([(i, i=1, size(ModData))], ModIDs == Module_HD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_Orca)] + + ! Ordering array for Option 1 modules that were not in Option 2 + ! These modules need to do update states and calc output before Option 1 solve + p%iModOpt1US = [pack([(i, i=1, size(ModData))], ModIDs == Module_ExtPtfm), & + pack([(i, i=1, size(ModData))], ModIDs == Module_HD), & + pack([(i, i=1, size(ModData))], ModIDs == Module_Orca)] !---------------------------------------------------------------------------- - ! Module substepping + ! Initialize mesh mappings (must be done before calculating global indices) !---------------------------------------------------------------------------- - ! Loop through module data - do i = 1, size(ModData) - - ! Calculate the number of substeps - ModData(i)%SubSteps = nint(p%DT/ModData(i)%DT) - - ! If module time step is same as global time step, set substeps to 1 - if (EqualRealNos(ModData(i)%DT, p%DT)) cycle - - ! If the module time step is greater than the global time step, set error - if (ModData(i)%DT > p%DT) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData(i)%Abbr)// & - " module time step ("//trim(Num2LStr(ModData(i)%DT))//" s) "// & - "cannot be larger than FAST time step ("//trim(Num2LStr(p%DT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - - ! If the module DT is not an exact integer divisor of the global time step, set error - if (.not. EqualRealNos(p%DT, ModData(i)%DT*ModData(i)%SubSteps)) then - call SetErrStat(ErrID_Fatal, "The "//trim(ModData(i)%Abbr)// & - " module time step ("//trim(Num2LStr(ModData(i)%DT))//" s) "// & - "must be an integer divisor of the FAST time step ("//trim(Num2LStr(p%DT))//" s).", & - ErrStat, ErrMsg, RoutineName) - return - end if - end do + call InitMeshMappings(m%Mappings, ModData, p%iModOpt1, p%iModOpt2, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Calculate Variable cateogries and global indices @@ -105,32 +105,50 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) NumX = 0 do i = 1, size(ModData) + vec1 = [(0, k=1, 0)] + vec2 = [(0, k=1, 0)] do j = 1, size(ModData(i)%Vars%x) ModData(i)%Vars%x(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%x(j)%Field) - ModData(i)%Vars%x(j)%iGbl = [(NumX + k, k=1, ModData(i)%Vars%x(j)%Size)] - NumX = NumX + ModData(i)%Vars%x(j)%Size + if (ModData(i)%Vars%x(j)%Cat == VC_Tight) then + ModData(i)%Vars%x(j)%iGblSol = [(NumX + k, k=1, ModData(i)%Vars%x(j)%Size)] + vec1 = [vec1, ModData(i)%Vars%x(j)%iLoc] + vec2 = [vec2, ModData(i)%Vars%x(j)%iGblSol] + NumX = NumX + ModData(i)%Vars%x(j)%Size + end if end do - call MV_CollectGlobalIndices(ModData(i)%Vars%x, ModData(i)%Vars%ixg) + ModData(i)%ixs = reshape([vec1, vec2], [size(vec1), 2]) end do NumU = 0 do i = 1, size(ModData) + vec1 = [(0, k=1, 0)] + vec2 = [(0, k=1, 0)] do j = 1, size(ModData(i)%Vars%u) ModData(i)%Vars%u(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%u(j)%Field) - ModData(i)%Vars%u(j)%iGbl = [(NumU + k, k=1, ModData(i)%Vars%u(j)%Size)] - NumU = NumU + ModData(i)%Vars%u(j)%Size + if (iand(ModData(i)%Vars%u(j)%Flags, VF_Solve) > 0) then + ModData(i)%Vars%u(j)%iGblSol = [(NumU + k, k=1, ModData(i)%Vars%u(j)%Size)] + vec1 = [vec1, ModData(i)%Vars%u(j)%iLoc] + vec2 = [vec2, ModData(i)%Vars%u(j)%iGblSol] + NumU = NumU + ModData(i)%Vars%u(j)%Size + end if end do - call MV_CollectGlobalIndices(ModData(i)%Vars%u, ModData(i)%Vars%iug) + ModData(i)%ius = reshape([vec1, vec2], [size(vec1), 2]) end do NumY = 0 do i = 1, size(ModData) + vec1 = [(0, k=1, 0)] + vec2 = [(0, k=1, 0)] do j = 1, size(ModData(i)%Vars%y) ModData(i)%Vars%y(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%y(j)%Field) - ModData(i)%Vars%y(j)%iGbl = [(NumY + k, k=1, ModData(i)%Vars%y(j)%Size)] - NumY = NumY + ModData(i)%Vars%y(j)%Size + if (iand(ModData(i)%Vars%y(j)%Flags, VF_Solve) > 0) then + ModData(i)%Vars%y(j)%iGblSol = [(NumY + k, k=1, ModData(i)%Vars%y(j)%Size)] + vec1 = [vec1, ModData(i)%Vars%y(j)%iLoc] + vec2 = [vec2, ModData(i)%Vars%y(j)%iGblSol] + NumY = NumY + ModData(i)%Vars%y(j)%Size + end if end do - call MV_CollectGlobalIndices(ModData(i)%Vars%y, ModData(i)%Vars%iyg) + ModData(i)%iys = reshape([vec1, vec2], [size(vec1), 2]) end do !---------------------------------------------------------------------------- @@ -151,10 +169,7 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) call AllocAry(m%un, NumU, "m%un", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%du, NumU, "m%du", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%u_tmp, NumU, "m%u_tmp", ErrStat2, ErrMsg2); if (Failed()) return - m%u = 0.0_R8Ki - m%un = 0.0_R8Ki - m%du = 0.0_R8Ki - m%u_tmp = 0.0_R8Ki + call AllocAry(m%UDiff, NumU, "m%UDiff", ErrStat2, ErrMsg2); if (Failed()) return ! Outputs call AllocAry(m%y, NumY, "m%y", ErrStat2, ErrMsg2); if (Failed()) return @@ -209,11 +224,9 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) ! If field is not the same or a derivative of current field, skip select case (ModData(i)%Vars%x(j)%Field) - case (VF_Orientation) - if (ModData(i)%Vars%x(k)%Field /= VF_Orientation) cycle case (VF_TransDisp, VF_TransVel, VF_TransAcc) if (all(ModData(i)%Vars%x(k)%Field /= TransFields)) cycle - case (VF_AngularDisp, VF_AngularVel, VF_AngularAcc) + case (VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc) if (all(ModData(i)%Vars%x(k)%Field /= AngularFields)) cycle case (VF_Force, VF_Moment) cycle @@ -230,7 +243,7 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) do j = 1, size(ModData(i)%Vars%x) do k = 1, ModData(i)%Vars%x(j)%Size n = n + 1 - p%ixqd(:, n) = [ModData(i)%Vars%x(j)%iGbl(k), iq(j) + k - 1, ModData(i)%Vars%x(j)%DerivOrder + 1] + p%ixqd(:, n) = [ModData(i)%Vars%x(j)%iGblSol(k), iq(j) + k - 1, ModData(i)%Vars%x(j)%DerivOrder + 1] end do end do @@ -261,46 +274,54 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) if (ModData(i)%Vars%x(j)%Cat == VC_Tight) then select case (ModData(i)%Vars%x(j)%DerivOrder) case (0) - p%iX1Tight = [p%iX1Tight, ModData(i)%Vars%x(j)%iGbl] + p%iX1Tight = [p%iX1Tight, ModData(i)%Vars%x(j)%iGblSol] case (1) - p%iX2Tight = [p%iX2Tight, ModData(i)%Vars%x(j)%iGbl] + p%iX2Tight = [p%iX2Tight, ModData(i)%Vars%x(j)%iGblSol] end select end if end do end do ! Calculate index mapping arrays for U^Tight and U^Option1 + call AllocAry(p%iuLoad, 0, "p%iuLoad", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(p%iUTight, 0, "p%iUTight", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(p%iUOpt1, 0, "p%iUOpt1", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(isLoadTight, 0, "isLoadTight", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(isLoadOption1, 0, "isLoadOption1", ErrStat2, ErrMsg2); if (Failed()) return - ! do i = 1, size(ModData) - ! do j = 1, size(ModData(i)%Vars%u) - ! isLoad = any(LoadFields == ModData(i)%Vars%u(j)%Field) - ! select case (ModData(i)%Vars%u(j)%Cat) - ! case (VC_Tight) - ! p%iUTight = [p%iUTight, ModData(i)%Vars%u(j)%iGbl] - ! isLoadTight = [isLoadTight, spread(isLoad, 1, ModData(i)%Vars%u(j)%Size)] - ! case (VC_Option1) - ! p%iUOpt1 = [p%iUOpt1, ModData(i)%Vars%u(j)%iGbl] - ! isLoadOption1 = [isLoadOption1, spread(isLoad, 1, ModData(i)%Vars%u(j)%Size)] - ! end select - ! end do - ! end do + do i = 1, size(ModData) + do j = 1, size(ModData(i)%Vars%u) + associate (Var => ModData(i)%Vars%u(j)) + if (iand(Var%Flags, VF_Solve) == 0) cycle + isLoad = any(LoadFields == Var%Field) + select case (Var%Cat) + case (VC_Tight) + p%iUTight = [p%iUTight, Var%iGblSol] + isLoadTight = [isLoadTight, spread(isLoad, 1, Var%Size)] + case (VC_Option1) + p%iUOpt1 = [p%iUOpt1, Var%iGblSol] + isLoadOption1 = [isLoadOption1, spread(isLoad, 1, Var%Size)] + end select + if (isLoad) then + p%iuLoad = [p%iuLoad, Var%iGblSol] + end if + end associate + end do + end do ! Calculate index mapping arrays for y^Tight and y^Option1 call AllocAry(p%iyTight, 0, "p%iyTight", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(p%iyOpt1, 0, "p%iyOpt1", ErrStat2, ErrMsg2); if (Failed()) return - ! do i = 1, size(ModData) - ! do j = 1, size(ModData(i)%Vars%u) - ! select case (ModData(i)%Vars%u(j)%Cat) - ! case (VC_Tight) - ! p%iyTight = [p%iyTight, ModData(i)%Vars%u(j)%iGbl] - ! case (VC_Option1) - ! p%iyOpt1 = [p%iyOpt1, ModData(i)%Vars%u(j)%iGbl] - ! end select - ! end do - ! end do + do i = 1, size(ModData) + do j = 1, size(ModData(i)%Vars%y) + if (iand(ModData(i)%Vars%y(j)%Flags, VF_Solve) == 0) cycle + select case (ModData(i)%Vars%y(j)%Cat) + case (VC_Tight) + p%iyTight = [p%iyTight, ModData(i)%Vars%y(j)%iGblSol] + case (VC_Option1) + p%iyOpt1 = [p%iyOpt1, ModData(i)%Vars%y(j)%iGblSol] + end select + end do + end do !---------------------------------------------------------------------------- ! Allocate Jacobian matrices @@ -312,7 +333,10 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) call AllocAry(m%dXdu, NumX, NumU, "m%dXdu", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%dUdu, NumU, NumU, "m%dUdu", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%dUdy, NumU, NumY, "m%dUdy", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%G, NumU, NumU, "m%G", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%IPIV2, NumU, "m%IPIV2", ErrStat2, ErrMsg2); if (Failed()) return + ! Initialize Jacobian matrices m%dYdx = 0.0_R8Ki m%dYdu = 0.0_R8Ki m%dXdx = 0.0_R8Ki @@ -320,21 +344,6 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) m%dUdu = 0.0_R8Ki m%dUdy = 0.0_R8Ki - ! Populate dUdu - do i = 1, NumU - m%dUdu(i, i) = 1.0_R8Ki - end do - - ! TODO: Figure out how to calculate from mesh mapping - ! Populate dUdy based on output/input transfer relationships - ! do i = 1, size(p%Vars%u) - ! do j = 1, size(p%Vars%u(i)%iy) - ! do k = 1, size(p%Vars%u(i)%iGbl) - ! m%dUdy(p%Vars%u(i)%iGbl(k), p%Vars%u(i)%iy(k, j)) = -1.0_R8Ki - ! end do - ! end do - ! end do - !---------------------------------------------------------------------------- ! Allocate Jacobian matrix, RHS, and Delta !---------------------------------------------------------------------------- @@ -361,36 +370,77 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) call AllocAry(m%Jac, NumJac, NumJac, "m%Jac", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%XB, NumJac, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return call AllocAry(m%IPIV, NumJac, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return + m%Jac = 0.0_R8Ki !---------------------------------------------------------------------------- - ! Module ordering for solve + ! Calculate generalized alpha parameters !---------------------------------------------------------------------------- - ! Get array of module IDs - modIDs = [(ModData(i)%ID, i=1, size(ModData))] + p%AccBlend = 1.0_R8Ki - ! Allocate ordering array for all modules - p%iModAll = [pack([(i, i=1, size(ModData))], ModIDs == Module_SrvD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_AD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & - pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) + p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) + p%Gamma = 0.5_R8Ki - p%AlphaM + p%AlphaF + p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2/4.0_R8Ki - p%iModTC = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & - pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + p%C(1) = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + p%C(2) = p%DT*p%Gamma*p%C(1) + p%C(3) = p%DT**2*p%Beta*p%C(1) - ! TODO: Add other modules - p%iModOpt2 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED)] + !---------------------------------------------------------------------------- + ! Debug + !---------------------------------------------------------------------------- - ! TODO: Add other modules - p%iModOpt1 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED)] + ! call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return + ! call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return + + ! call GetNewUnit(munit, ErrStat2, ErrMsg2); if (Failed()) return + + ! write (m%DebugUnit, *) "NumX = ", NumX + ! write (m%DebugUnit, *) "NumU = ", NumU + ! write (m%DebugUnit, *) "NumY = ", NumY + ! write (m%DebugUnit, *) "NumY = ", NumY + ! write (m%DebugUnit, *) "NumJac = ", NumY + ! write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 + ! write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT + ! write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 + ! write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL + ! write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight + ! write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 + ! write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight + ! write (m%DebugUnit, '(A,*(I4))') " p%iyOpt1 = ", p%iyOpt1 + ! write (m%DebugUnit, *) "shape(m%dYdx) = ", shape(m%dYdx) + ! write (m%DebugUnit, *) "shape(m%dYdu) = ", shape(m%dYdu) + ! write (m%DebugUnit, *) "shape(m%dXdx) = ", shape(m%dXdx) + ! write (m%DebugUnit, *) "shape(m%dXdu) = ", shape(m%dXdu) + ! write (m%DebugUnit, *) "shape(m%dUdu) = ", shape(m%dUdu) + ! write (m%DebugUnit, *) "shape(m%dUdy) = ", shape(m%dUdy) - ! Option 1 modules that require input solve and update states - ! TODO: Add aerodyn with hydrodynamics - p%iModOpt1US = [pack([(i, i=1, size(ModData))], ModIDs == Module_ExtPtfm), & - pack([(i, i=1, size(ModData))], ModIDs == Module_HD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_Orca)] + ! do i = 1, size(ModData) + ! write (m%DebugUnit, *) "Module = ", ModData(i)%Abbr + ! write (m%DebugUnit, *) "ModuleID = ", ModData(i)%ID + ! do j = 1, size(ModData(i)%Vars%x) + ! if (.not. allocated(ModData(i)%Vars%x(j)%iGblSol)) cycle + ! write (m%DebugUnit, *) "Var = "//trim(ModData(i)%Abbr)//trim(Num2LStr(ModData(i)%Instance))//" X "//trim(ModData(i)%Vars%x(j)%Name)// & + ! " ("//trim(MV_FieldString(ModData(i)%Vars%x(j)%Field))//")" + ! write (m%DebugUnit, '(A,*(I4))') " X iLoc = ", ModData(i)%Vars%x(j)%iLoc + ! write (m%DebugUnit, '(A,*(I4))') " X iGblSol = ", ModData(i)%Vars%x(j)%iGblSol + ! end do + ! do j = 1, size(ModData(i)%Vars%u) + ! if (.not. allocated(ModData(i)%Vars%u(j)%iGblSol)) cycle + ! write (m%DebugUnit, *) "Var = "//trim(ModData(i)%Abbr)//trim(Num2LStr(ModData(i)%Instance))//" U "//trim(ModData(i)%Vars%u(j)%Name)// & + ! " ("//trim(MV_FieldString(ModData(i)%Vars%u(j)%Field))//")" + ! write (m%DebugUnit, '(A,*(I4))') " U iLoc = ", ModData(i)%Vars%u(j)%iLoc + ! write (m%DebugUnit, '(A,*(I4))') " U iGblSol = ", ModData(i)%Vars%u(j)%iGblSol + ! end do + ! do j = 1, size(ModData(i)%Vars%y) + ! if (.not. allocated(ModData(i)%Vars%y(j)%iGblSol)) cycle + ! write (m%DebugUnit, *) "Var = "//trim(ModData(i)%Abbr)//trim(Num2LStr(ModData(i)%Instance))//" Y "//trim(ModData(i)%Vars%y(j)%Name)// & + ! " ("//trim(MV_FieldString(ModData(i)%Vars%y(j)%Field))//")" + ! write (m%DebugUnit, '(A,*(I4))') " Y iLoc = ", ModData(i)%Vars%y(j)%iLoc + ! write (m%DebugUnit, '(A,*(I4))') " Y iGblSol = ", ModData(i)%Vars%y(j)%iGblSol + ! end do + ! end do contains function Failed() @@ -418,6 +468,196 @@ pure function VarCategory(ModID, VarField) result(VarCat) VarCat = VC_None end select end function + +end subroutine + +subroutine InitMeshMappings(Mappings, ModData, iModOpt1, iModOpt2, ErrStat, ErrMsg) + type(TC_MeshMapType), allocatable, intent(inout) :: Mappings(:) + integer(IntKi), intent(in) :: iModOpt1(:) + integer(IntKi), intent(in) :: iModOpt2(:) + type(ModDataType), intent(inout) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'InitMeshMappings' + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + integer(IntKi) :: iMap, iModOut, iModIn, i, j + logical, allocatable :: isActive(:) + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Define mesh mappings between modules + !---------------------------------------------------------------------------- + + ! Define a list of all possible module mesh mappings between modules + ! Note: the mesh names must map those defined in MV_AddMeshVar in the modules + allocate (Mappings(0), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) + return + end if + + do iMap = 1, size(ModData) + if (ModData(iMap)%ID == Module_BD) then + iModOut = ModData(iMap)%Ins + call AddMotionMapping(Key='ED BladeRoot -> BD RootMotion', & + SrcModID=Module_ED, SrcModInst=1, SrcMeshName='Blade root '//trim(Num2LStr(iModOut)), & + DstModID=Module_BD, DstModInst=iModOut, DstMeshName='RootMotion') + call AddLoadMapping(Key='BD ReactionForce -> ED HubLoad', & + SrcModID=Module_BD, SrcModInst=iModOut, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & + DstModID=Module_ED, DstModInst=1, DstMeshName='Hub', DstDispMeshName='Hub') + end if + end do + + !---------------------------------------------------------------------------- + ! Get module indices in ModData and determine which mappings are active + !---------------------------------------------------------------------------- + + ! Allocate array to indicate if mapping is active and initialize to false + call AllocAry(isActive, size(Mappings), "isActive", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + isActive = .false. + + ! Loop through mappings + do iMap = 1, size(Mappings) + + ! Loop through output modules + do iModOut = 1, size(ModData) + + ! If mapping output module ID or instance doesn't match, cycle + if ((Mappings(iMap)%SrcModID /= ModData(iModOut)%ID) .or. (Mappings(iMap)%SrcModInst /= ModData(iModOut)%Ins)) cycle + + ! Loop through input modules + do iModIn = 1, size(ModData) + + ! If mapping input module ID or instance doesn't match, cycle + if ((Mappings(iMap)%DstModID /= ModData(iModIn)%ID) .or. (Mappings(iMap)%DstModInst /= ModData(iModIn)%Ins)) cycle + + ! Module input/ouput IDs and instances found, populate mapping + Mappings(iMap)%SrcModIdx = iModOut + Mappings(iMap)%DstModIdx = iModIn + isActive(iMap) = .true. + + ! If the input module is in Option 1 and the output module is + ! before it, add mapping index to array of Option 1 maps for input + i = FindIndex(iModOpt1, iModIn) + if (i > 0) then + if (FindIndex(iModOpt1(:i), iModOut) > 0) then + ModData(iModIn)%iMapsOpt1 = [ModData(iModIn)%iMapsOpt1, iMap] + end if + end if + + ! If the input module is in Option 2 and the output module is + ! before it, add mapping index to array of Option 2 maps for input + i = FindIndex(iModOpt2, iModIn) + if (i > 0) then + if (FindIndex(iModOpt2(:i), iModOut) > 0) then + ModData(iModIn)%iMapsOpt2 = [ModData(iModIn)%iMapsOpt2, iMap] + end if + end if + + ! Add mapping to all index + ModData(iModIn)%iMapsAll = [ModData(iModIn)%iMapsAll, iMap] + end do + end do + + ! If mapping was not marked as active, cycle + if (.not. isActive(iMap)) cycle + + associate (map => Mappings(iMap), & + SrcMod => ModData(Mappings(iMap)%SrcModIdx), & + DstMod => ModData(Mappings(iMap)%DstModIdx)) + + ! If load mapping + if (map%IsLoad) then + + ! Source mesh variable indices + map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, LoadFields(iModOut)), iModOut=1, size(LoadFields))] + map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) + + ! Destination mesh variable indices + map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, LoadFields(iModOut)), iModOut=1, size(LoadFields))] + map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) + + ! Source displacement mesh is in input of source module (only translation displacement needed) + map%SrcDispVarIdx = MV_VarIndex(SrcMod%Vars%u, map%SrcDispMeshName, VF_TransDisp) + + ! Destination displacement mesh is in output of destination module (only translation displacement needed) + map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, map%DstDispMeshName, VF_TransDisp) + + ! Mark displacement variables with Solve flag + call SetFlags(SrcMod%Vars%u(map%SrcDispVarIdx), VF_Solve) + call SetFlags(DstMod%Vars%y(map%DstDispVarIdx), VF_Solve) + + else + + ! Source mesh motion field variables + map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(iModOut)), iModOut=1, size(MotionFields))] + map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) + + ! Destination mesh motion field variables + map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(iModOut)), iModOut=1, size(MotionFields))] + map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) + + end if + + ! Mark variables with Solve flag + do iModOut = 1, size(map%SrcVarIdx) + call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(iModOut)), VF_Solve) + end do + do iModOut = 1, size(map%DstVarIdx) + call SetFlags(DstMod%Vars%u(map%DstVarIdx(iModOut)), VF_Solve) + end do + + end associate + + end do + + ! Remove inactive mappings + Mappings = pack(Mappings, mask=isActive) + +contains + subroutine AddLoadMapping(Key, SrcModID, SrcModInst, SrcMeshName, SrcDispMeshName, & + DstModID, DstModInst, DstMeshName, DstDispMeshName) + character(*), intent(in) :: Key + integer(IntKi), intent(in) :: SrcModID, DstModID + integer(IntKi), intent(in) :: SrcModInst, DstModInst + character(*), intent(in) :: SrcMeshName, DstMeshName + character(*), intent(in) :: SrcDispMeshName, DstDispMeshName + if (.not. allocated(Mappings)) allocate (Mappings(0)) + Mappings = [Mappings, TC_MeshMapType(Key=Key, isLoad=.true., & + SrcModID=SrcModID, SrcModInst=SrcModInst, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & + DstModID=DstModID, DstModInst=DstModInst, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] + end subroutine + subroutine AddMotionMapping(Key, SrcModID, SrcModInst, SrcMeshName, & + DstModID, DstModInst, DstMeshName) + character(*), intent(in) :: Key + integer(IntKi), intent(in) :: SrcModID, DstModID + integer(IntKi), intent(in) :: SrcModInst, DstModInst + character(*), intent(in) :: SrcMeshName, DstMeshName + if (.not. allocated(Mappings)) allocate (Mappings(0)) + Mappings = [Mappings, TC_MeshMapType(Key=Key, isLoad=.false., & + SrcModID=SrcModID, SrcModInst=SrcModInst, SrcMeshName=SrcMeshName, & + DstModID=DstModID, DstModInst=DstModInst, DstMeshName=DstMeshName)] + end subroutine + function FindIndex(ModOrder, Ind) result(OutInd) + integer(IntKi), intent(in) :: ModOrder(:) + integer(IntKi), intent(in) :: Ind + integer(IntKi) :: OutInd + integer(IntKi) :: i + OutInd = 0 + do i = 1, size(ModOrder) + if (ModOrder(i) == Ind) then + OutInd = i + exit + end if + end do + end function end subroutine subroutine Solver_TransferXtoQ(ixqd, x, q) @@ -478,6 +718,13 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' + !---------------------------------------------------------------------------- + ! Initialize module mappings + ! TODO: Move this into init + !---------------------------------------------------------------------------- + + call FAST_InitMappings(m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + !---------------------------------------------------------------------------- ! Miscellaneous initial step !---------------------------------------------------------------------------- @@ -492,15 +739,12 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) end if - ! TODO: Add SrvD_SetExternalInputs - ! TODO: Add SeaSt_CalcOutput - !---------------------------------------------------------------------------- ! Calculate initial accelerations !---------------------------------------------------------------------------- ! Transfer initial state from modules to solver - call TransferFromModules(p%iModTC, ModData, STATE_CURR, Turbine, x=m%x) + call PackModuleStates(ModData(p%iModTC), STATE_CURR, Turbine, x=m%x) ! Transfer initial state to next state q matrix (qn) ! The qn matrix is being used because the solution step routine predicts @@ -519,12 +763,18 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) do while ((.not. converged) .and. (k <= p%MaxConvIter)) ! Transfer inputs and calculate outputs for all modules (use current state) - call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_CURR, & - EM_InputSolve + EM_CalcOutput, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%iModAll) + call FAST_InputSolve(ModData(p%iModAll(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_CalcOutput(ModData(p%iModAll(i)), t_initial, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do ! Calculate continuous state derivatives for tight coupling modules (use current state) - call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_CURR, & - EM_CalcContStateDeriv, Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return + do i = 1, size(p%iModTC) + call FAST_CalcContStateDeriv(ModData(p%iModTC(i)), t_initial, STATE_CURR, & + Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return + end do ! Copy acceleration (derivative of velocity) to acceleration array. ! Loop through x->q index array and transfer derivative of @@ -548,43 +798,33 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Print warning if not converged if (.not. converged) then - call WrScr("Solver: initial accel not converged, diff="//Num2LStr(diff)//", tol="//Num2LStr(p%ConvTol)) + call WrScr("Solver: initial accel not converged, diff="//Num2LStr(diff)// & + ", tol="//Num2LStr(p%ConvTol)) end if ! Initialize algorithmic acceleration from actual acceleration m%qn(:, COL_AA) = m%qn(:, COL_A) - ! m%qn(:, COL_A) = 0.0_R8Ki !---------------------------------------------------------------------------- ! Initialize module input and state arrays for interpolation/extrapolation !---------------------------------------------------------------------------- - call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_CURR, & - EM_InitIO, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Calculate inititial Jacobian - !---------------------------------------------------------------------------- - - ! Calculate the Jacobians for TC modules - call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_CURR, & - EM_JacobianPContState + EM_JacobianPInput, Turbine, ErrStat2, ErrMsg2, & - dYdx=m%dYdx, dXdx=m%dXdx, dYdu=m%dYdu, dXdu=m%dXdu); if (Failed()) return - - ! Calculate the Jacobian - call CalcJacobian(p, m, ErrStat2, ErrMsg2); if (Failed()) return + ! Loop through all module index array + do i = 1, size(p%iModAll) - !---------------------------------------------------------------------------- - ! Supercontroller - !---------------------------------------------------------------------------- + ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) + call FAST_InitIO(ModData(p%iModAll(i)), t_initial, p%DT, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - ! TODO: add SC_DX_SetInputs + ! Reset the Remap flags for all modules + call FAST_ResetRemapFlags(ModData(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do !---------------------------------------------------------------------------- - ! Write Output + ! Calculate inititial Jacobian !---------------------------------------------------------------------------- - call WriteOutputToFile(n_t_global_next, t_initial, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + ! Calculate the solver Jacobian + call Solver_BuildJacobian(p, m, ModData, t_initial, Turbine, ErrStat2, ErrMsg2); if (Failed()) return contains function Failed() @@ -594,12 +834,12 @@ function Failed() end function end subroutine -subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, ErrMsg) +subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrMsg) integer(IntKi), intent(in) :: n_t_global !< global time step real(DbKi), intent(in) :: t_initial !< Initial simulation time type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inout) :: m !< Misc variables - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -613,6 +853,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E real(ReKi) :: delta_norm real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 + integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' @@ -628,30 +869,19 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E ! Determine if output should be written in this step Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, t_initial, Turbine%p_FAST%n_DT_Out) - ! Set number of corrections to be used for this time step - if (Turbine%p_FAST%CompElast /= Module_BD) then - ! Use input file value if BeamDyn is not used - NumCorrections = Turbine%p_FAST%NumCrctn - else if (n_t_global == 0) then - ! BD accelerations have fewer spikes on the first several time steps with these corrections - NumCorrections = max(Turbine%p_FAST%NumCrctn, 16) - else if (n_t_global <= 2) then - ! Use at least 1 correction on the first 3 steps (the 2 should probably be related to Turbine%p_FAST%InterpOrder) - NumCorrections = max(Turbine%p_FAST%NumCrctn, 1) - else - ! Use input file value on subsequent steps - NumCorrections = Turbine%p_FAST%NumCrctn - end if - ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 + ! write (m%DebugUnit, *) "step = ", n_t_global_next + !---------------------------------------------------------------------------- ! Extrapolate/interpolate inputs for all modules !---------------------------------------------------------------------------- - call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_PRED, & - EM_ExtrapInterp, Turbine, ErrStat2, ErrMsg2) + ! Loop through all modules and extrap/interp inputs + do i = 1, size(p%iModAll) + call FAST_ExtrapInterp(Mods(p%iModAll(i)), t_global_next, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do !---------------------------------------------------------------------------- ! Prediction - guess solution state variables at end of time step @@ -660,14 +890,29 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E ! Calculate displacements, velocities, and accelerations for next step associate (q => m%qn(:, 1), qd => m%qn(:, 2), qdd => m%qn(:, 3), aa => m%qn(:, 4), & nq => m%q(:, 1), nqd => m%q(:, 2), nqdd => m%q(:, 3), naa => m%q(:, 4)) - nqdd = qdd*p%AccBlend ! Acceleration - naa = ((1.0_R8Ki - p%AlphaF)*nqdd + p%AlphaF*qdd - p%AlphaM*aa)/(1 - p%AlphaM) ! Algorithmic acceleration - nq = q + p%DT*qd + p%DT**2*(0.5 - p%Beta)*aa + p%DT**2*p%Beta*naa ! Displacment - nqd = qd + p%DT*(1 - p%Gamma)*aa + p%DT*p%Gamma*naa ! Velocity + nqdd = qdd*p%AccBlend ! Acceleration + naa = ((1.0_R8Ki - p%AlphaF)*nqdd + p%AlphaF*qdd - p%AlphaM*aa)/(1 - p%AlphaM) ! Algorithmic acceleration + nqd = qd + p%DT*(1 - p%Gamma)*aa + p%DT*p%Gamma*naa ! Velocity + nq = q + p%DT*qd + p%DT**2*(0.5 - p%Beta)*aa + p%DT**2*p%Beta*naa ! Displacment end associate - ! Transfer algorithm matrix to solver states - call Solver_TransferQtoX(p%ixqd, m%q, m%x) + ! Calculate difference in state matrix (q is the updated state matrix now) + m%dq = m%q - m%qn + + ! Transfer delta state matrix to delta x array + call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) + + ! Add delta to x array to get new states (respect variable fields) + ! required for orientation fields in states + call AddDeltaToStates(Mods, p%iModTC, m%dx, m%x) + + ! Update state matrix with values updated by adding deltas + call Solver_TransferXtoQ(p%ixqd, m%x, m%q) + + ! Initialize delta arrays for iterations + m%dq = 0.0_R8Ki + m%dx = 0.0_R8Ki + m%du = 0.0_R8Ki !---------------------------------------------------------------------------- ! Correction Iterations @@ -677,30 +922,35 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E iterCorr = 0 do while (iterCorr <= p%NumCrctn) + ! write (m%DebugUnit, *) "iterCorr = ", iterCorr + ! Copy state for correction step m%qn = m%q m%xn = m%x - ! Reset state matrix delta - m%dq = 0.0_R8Ki - - ! Option 2 calculation: - ! - Input Solve - ! - Update states from current to predicted (set new states in TC modules) - ! - Calculate output - call FAST_EvalModules(t_initial, n_t_global, p%iModOpt2, ModData, STATE_PRED, & - EM_UpdateStates + EM_InputSolve + EM_CalcOutput, & - Turbine, ErrStat2, ErrMsg2, x=m%xn); if (Failed()) return + ! Unpack the updated states into the modules + call UnpackModuleStates(Mods, p%iModTC, STATE_PRED, Turbine, m%xn) + + ! Loop through Option 2 modules + do i = 1, size(p%iModOpt2) + call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do - ! Option 1 modules not in Option 2: - ! - Input solve - ! - Update states - call FAST_EvalModules(t_initial, n_t_global, p%iModOpt1US, ModData, STATE_PRED, & - EM_InputSolve + EM_UpdateStates, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + ! Get inputs and update states for Option 1 modules not in Option 2 + do i = 1, size(p%iModOpt1US) + call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do - ! Get all current inputs - call TransferFromModules(p%iModAll, ModData, STATE_PRED, Turbine, u=m%un) + ! Pack Option 1 inputs into u array + call PackModuleInputs(Mods, p%iModOpt1, Turbine, u=m%un) !------------------------------------------------------------------------- ! Convergence Iterations @@ -709,6 +959,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E ! Loop through convergence iterations do iterConv = 0, p%MaxConvIter + ! write (m%DebugUnit, *) "iterConv = ", iterConv + ! Decrement number of iterations before updating the Jacobian m%IterUntilUJac = m%IterUntilUJac - 1 @@ -716,9 +968,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E ! Option 1 calculate outputs !---------------------------------------------------------------------- - call FAST_EvalModules(t_initial, n_t_global, p%iModOpt1, ModData, STATE_PRED, & - EM_CalcOutput, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%iModOpt1) + call FAST_CalcOutput(Mods(p%iModOpt1(i)), t_global_next, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do + call PackModuleOutputs(Mods, p%iModOpt1, Turbine, m%y) !---------------------------------------------------------------------- ! If iteration limit reached, exit loop @@ -731,18 +985,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E !---------------------------------------------------------------------- ! If number of iterations or steps until Jacobian is to be updated - ! is zero or less, then update the Jacobian. Note: CalcJacobian + ! is zero or less, then rebuild the Jacobian. Note: Solver_BuildJacobian ! resets these counters. if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0)) then - - ! Calculate Jacobians for TC modules - call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_PRED, & - EM_JacobianPContState + EM_JacobianPInput, & - Turbine, ErrStat2, ErrMsg2, & - dYdx=m%dYdx, dXdx=m%dXdx, dYdu=m%dYdu, dXdu=m%dXdu); if (Failed()) return - - ! Calculate the Jacobian - call CalcJacobian(p, m, ErrStat2, ErrMsg2); if (Failed()) return + call Solver_BuildJacobian(p, m, Mods, t_global_next, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return end if !---------------------------------------------------------------------- @@ -750,25 +997,32 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E !---------------------------------------------------------------------- ! Calculate continuous state derivatives for tight coupling modules - call FAST_EvalModules(t_initial, n_t_global, p%iModTC, ModData, STATE_PRED, & - EM_CalcContStateDeriv, Turbine, ErrStat2, ErrMsg2, & - dxdt=m%dxdt); if (Failed()) return - - ! Option 1 transfer outputs to inputs - call FAST_EvalModules(t_initial, n_t_global, p%iModOpt1, ModData, STATE_PRED, & - EM_InputSolve, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - - ! Get all updated inputs and store in temporary input variable - call TransferFromModules(p%iModOpt1, ModData, STATE_PRED, Turbine, u=m%u_tmp) + do i = 1, size(p%iModTC) + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return + end do - ! Calculate difference between predicted and actual acceleration and add to RHS + ! Calculate difference between predicted and actual accelerations m%XB(p%iJX2, 1) = m%qn(:, COL_A) - m%dxdt(p%iX2Tight) - ! Calculate difference in input/output and add to RHS - m%XB(p%iJT, 1) = m%un(p%iUTight) - m%u_tmp(p%iUTight) + ! Transfer Option 1 outputs to temporary inputs and collect into u_tmp + do i = 1, size(p%iModOpt1) + call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, 2, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do + call PackModuleInputs(Mods, p%iModOpt1, Turbine, u_tmp=m%u_tmp) + + ! Calculate difference in U for all Option 1 modules (un - u_tmp) + ! and add to RHS for TC and Option 1 modules + call ComputeDiffU(Mods, p%iModOpt1, m%un, m%u_tmp, m%UDiff) + m%XB(p%iJT, 1) = m%UDiff(p%iUTight) + m%XB(p%iJ1, 1) = m%UDiff(p%iUOpt1) - ! If Option 1 inputs, calc difference and add to RHS - if (size(p%iJ1) > 0) m%XB(p%iJ1, 1) = m%un(p%iUOpt1) - m%u_tmp(p%iUOpt1) + ! write (m%DebugUnit, '(A,*(ES16.7))') "m%y = ", m%y + ! write (m%DebugUnit, '(A,*(ES16.7))') "m%un-1 = ", m%un + ! write (m%DebugUnit, '(A,*(ES16.7))') "m%u_tmp = ", m%u_tmp + ! write (m%DebugUnit, '(A,*(ES16.7))') "m%UDiff = ", m%UDiff + ! write (m%DebugUnit, '(A,*(ES16.7))') "m%xn-1 = ", m%xn ! Apply conditioning factor to loads in RHS m%XB(p%iJL, 1) = m%XB(p%iJL, 1)/p%Scale_UJac @@ -788,50 +1042,65 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E !---------------------------------------------------------------------- delta_norm = TwoNorm(m%XB(:, 1)) + ! write (m%DebugUnit, *) "delta_norm = ", delta_norm if (delta_norm < p%ConvTol) exit !---------------------------------------------------------------------- ! Update State for Tight Coupling modules !---------------------------------------------------------------------- - ! Update delta state matrix - m%dq(:, COL_D) = m%dq(:, COL_D) - p%C(3)*m%XB(p%iJX2, 1) - m%dq(:, COL_V) = m%dq(:, COL_V) - p%C(2)*m%XB(p%iJX2, 1) - m%dq(:, COL_A) = m%dq(:, COL_A) - m%XB(p%iJX2, 1) - m%dq(:, COL_AA) = m%dq(:, COL_AA) - p%C(1)*m%XB(p%iJX2, 1) + ! Calculate change in state matrix + m%dq(:, COL_D) = -p%C(3)*m%XB(p%iJX2, 1) + m%dq(:, COL_V) = -p%C(2)*m%XB(p%iJX2, 1) + m%dq(:, COL_A) = -m%XB(p%iJX2, 1) + m%dq(:, COL_AA) = -p%C(1)*m%XB(p%iJX2, 1) ! Transfer change in q state matrix to change in x array call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) ! Add delta to x array to get new states (respect variable fields) - call AddDeltaToStates(ModData, p%iModTC, m%x, m%dx, m%xn) - - ! Calculate new state matrix as sum of previous state and deltas - m%qn = m%q + m%dq + call AddDeltaToStates(Mods, p%iModTC, m%dx, m%xn) ! Update new state matrix with new state array values + ! The transfer overwrites values that were changed in AddDeltaToStates + m%qn = m%qn + m%dq call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) - ! Transfer new state to modules - call TransferToModules(p%iModTC, ModData, STATE_PRED, Turbine, x=m%xn) + ! Transfer updated state to TC modules + call UnpackModuleStates(Mods, p%iModTC, STATE_PRED, Turbine, x=m%xn) !---------------------------------------------------------------------- ! Update inputs for Tight Coupling and Option 1 modules !---------------------------------------------------------------------- ! Update change in inputs - m%du(p%iUTight) = m%du(p%iUTight) - m%XB(p%iJT, 1) - m%du(p%iUOpt1) = m%du(p%iUOpt1) - m%XB(p%iJ1, 1) + m%du(p%iUTight) = -m%XB(p%iJT, 1) + m%du(p%iUOpt1) = -m%XB(p%iJ1, 1) ! Apply deltas to inputs, update modules - call AddDeltaToInputs(ModData, p%iModOpt1, m%u, m%du, m%un) - call TransferToModules(p%iModOpt1, ModData, STATE_PRED, Turbine, u=m%un) + call AddDeltaToInputs(Mods, p%iModOpt1, m%du, m%un) + + ! Transfer updated inputs to Option 1 modules + call UnpackModuleInputs(Mods, p%iModOpt1, Turbine, u=m%un) + + !---------------------------------------------------------------------- + ! Transfer updated states and inputs to relevant modules + !---------------------------------------------------------------------- + + ! write (m%DebugUnit, '(A,*(ES16.7))') " m%du = ", m%du + ! write (m%DebugUnit, '(A,*(ES16.7))') " m%un-2 = ", m%un + ! write (m%DebugUnit, '(A,*(ES16.7))') " m%dx = ", m%dx + ! write (m%DebugUnit, '(A,*(ES16.7))') " m%xn-2 = ", m%xn end do - m%u = m%un iterCorr = iterCorr + 1 + ! Reset the remap flags on the meshes + do i = 1, size(p%iModAll) + call FAST_ResetRemapFlags(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do + end do !---------------------------------------------------------------------------- @@ -839,8 +1108,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E !---------------------------------------------------------------------------- ! Copy the final predicted states from step t_global_next to actual states for that step - call FAST_EvalModules(t_initial, n_t_global, p%iModAll, ModData, STATE_PRED, & - EM_SavePredStates, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_SaveStates(Mods(p%iModAll), Turbine, ErrStat2, ErrMsg2); if (Failed()) return ! Save new state m%x = m%xn @@ -848,12 +1116,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E ! Update the global time Turbine%m_FAST%t_global = t_global_next - !---------------------------------------------------------------------------- - ! Write output to file - !---------------------------------------------------------------------------- - - call WriteOutputToFile(n_t_global_next, t_global_next, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): !---------------------------------------------------------------------------- @@ -866,64 +1128,167 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, ModData, Turbine, ErrStat, E end if contains - function Failed() - logical :: Failed + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function end subroutine -subroutine CalcJacobian(p, m, ErrStat, ErrMsg) +subroutine ComputeDiffU(Mods, ModOrder, PosAry, NegAry, DiffAry) + type(ModDataType), intent(in) :: Mods(:) ! Array of variables + integer(IntKi), intent(in) :: ModOrder(:) + real(R8Ki), intent(in) :: PosAry(:) ! Positive result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative result array + real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference + integer(IntKi) :: i, j, k, ind(3) + real(R8Ki) :: DeltaWM(3) + + ! Loop through module index order + do i = 1, size(ModOrder) + + ! Loop through input variables in module + do j = 1, size(Mods(ModOrder(i))%Vars%u) + + associate (Var => Mods(ModOrder(i))%Vars%u(j)) + + if (.not. allocated(Var%iGblSol)) cycle + + ! If variable field is orientation + if (Var%Field == VF_Orientation) then + + ! Loop through nodes + do k = 1, Var%Nodes + + ! Get vector of indicies of WM rotation parameters in array + ind = Var%iGblSol(3*(k - 1) + 1:3*k) + + ! Compose WM parameters to go from negative to positive array + DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) - type(TC_ParameterType), intent(in) :: p !< Parameters - type(TC_MiscVarType), intent(inOUT) :: m !< Misc variables - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg + ! Calculate change in rotation in XYZ in radians + DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) + end do - character(*), parameter :: RoutineName = 'CalcJacobian' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i + else + + ! Subtract negative array from positive array + DiffAry(Var%iGblSol) = PosAry(Var%iGblSol) - NegAry(Var%iGblSol) + end if + end associate + end do + end do +end subroutine + +subroutine Solver_BuildJacobian(p, m, ModData, this_time, Turbine, ErrStat, ErrMsg) + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(inOUT) :: m !< Misc variables + type(ModDataType), intent(in) :: ModData(:) !< Array of module data + real(DbKi), intent(in) :: this_time !< Time + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'Solver_BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + real(R8Ki), allocatable :: tmp(:, :) + real(R8Ki), dimension(3) :: wm_b, wm_p, wm_n, wm_d, wm_pert, delta ErrStat = ErrID_None ErrMsg = '' + ! Reset Jacobian update countdown values + m%IterUntilUJac = p%NIter_UJac + m%StepsUntilUJac = p%NStep_UJac + + !---------------------------------------------------------------------------- + ! Get module Jacobians and assemble + !---------------------------------------------------------------------------- + + ! Initialize matrices + m%dYdx = 0.0_R8Ki + m%dXdx = 0.0_R8Ki + m%dXdu = 0.0_R8Ki + m%dYdu = 0.0_R8Ki + m%dUdy = 0.0_R8Ki + call Eye2D(m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + + ! Calculate dYdx, dXdx, dXdu for tight coupling modules + do i = 1, size(p%iModTC) + call FAST_CalcJacobian(ModData(p%iModTC(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dYdx=m%dYdx, dXdx=m%dXdx, dXdu=m%dXdu); if (Failed()) return + end do + + ! Calculate dYdu Loop for Option 1 modules + do i = 1, size(p%iModOpt1) + call FAST_CalcJacobian(ModData(p%iModOpt1(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + dYdu=m%dYdu); if (Failed()) return + end do + + ! Calculate dUdu and dUdy for Option 1 meshes + call FAST_LinearizeMappings(ModData, p%iModOpt1, m%Mappings, Turbine, ErrStat2, ErrMsg2, & + dUdu=m%dUdu, dUdy=m%dUdy); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Form full system matrices + !---------------------------------------------------------------------------- + + !A: rows = x; columns = x (dXdx) + !B: rows = x; columns = u (dXdu) + !C: rows = y; columns = x (dYdx) + !D: rows = y; columns = u (dYdu) + + ! G + ! m%G = m%dUdu + matmul(m%dUdy, m%dYdu) + m%G = m%dUdu + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%dUdy, m%dYdu, 1.0_R8Ki, m%G, ErrStat2, ErrMsg2); if (Failed()) return + + ! call DumpMatrix(munit, "dUdu.bin", m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dUdy.bin", m%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "ED-dXdu.bin", Turbine%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "ED-dXdx.bin", Turbine%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "ED-dYdu.bin", Turbine%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "ED-dYdx.bin", Turbine%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "BD-dXdu.bin", Turbine%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "BD-dXdx.bin", Turbine%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "BD-dYdu.bin", Turbine%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "BD-dYdx.bin", Turbine%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------------- + ! Group (1,1) - m%Jac(p%iJX2, p%iJX2) = -p%C(2)*m%dXdx(p%iX2Tight, p%iX2Tight) - & - p%C(3)*m%dXdx(p%iX2Tight, p%iX1Tight) + m%Jac(p%iJX2, p%iJX2) = -p%C(2)*m%dXdx(p%iX2Tight, p%iX2Tight) - p%C(3)*m%dXdx(p%iX2Tight, p%iX1Tight) do i = 1, size(p%iJX2) - m%Jac(i, i) = m%Jac(i, i) + 1.0_R8Ki + m%Jac(p%iJX2(i), p%iJX2(i)) = m%Jac(p%iJX2(i), p%iJX2(i)) + 1.0_R8Ki end do ! Group (2,1) - m%Jac(p%iJT, p%iJX2) = p%C(2)*matmul(m%dUdy(p%iUTight, p%iyTight), & - m%dYdx(p%iyTight, p%iX2Tight)) + & - p%C(3)*matmul(m%dUdy(p%iUTight, p%iyTight), & - m%dYdx(p%iyTight, p%iX1Tight)) + m%Jac(p%iJT, p%iJX2) = p%C(2)*matmul(m%dUdy(p%iUTight, p%iyTight), m%dYdx(p%iyTight, p%iX2Tight)) + & + p%C(3)*matmul(m%dUdy(p%iUTight, p%iyTight), m%dYdx(p%iyTight, p%iX1Tight)) ! Group (1,2) m%Jac(p%iJX2, p%iJT) = -m%dXdu(p%iX2Tight, p%iUTight) ! Group (2,2) - m%Jac(p%iJT, p%iJT) = m%dUdu(p%iUTight, p%iUTight) + & - matmul(m%dUdy(p%iUTight, p%iyTight), & - m%dYdu(p%iyTight, p%iUTight)) + m%Jac(p%iJT, p%iJT) = m%G(p%iUTight, p%iUTight) + ! m%Jac(p%iJT, p%iJT) = m%dUdu(p%iUTight, p%iUTight) + & + ! matmul(m%dUdy(p%iUTight, p%iyTight), m%dYdu(p%iyTight, p%iUTight)) ! If modules in option 1 if (size(p%iJ1) > 0) then ! Group (3,2) m%Jac(p%iJ1, p%iJT) = m%dUdu(p%iUOpt1, p%iUTight) + & - matmul(m%dUdy(p%iUOpt1, p%iyTight), & - m%dYdu(p%iyTight, p%iUTight)) + matmul(m%dUdy(p%iUOpt1, p%iyTight), m%dYdu(p%iyTight, p%iUTight)) ! Group (2,3) m%Jac(p%iJT, p%iJ1) = m%dUdu(p%iUTight, p%iUOpt1) + & - matmul(m%dUdy(p%iUTight, p%iyOpt1), & - m%dYdu(p%iyOpt1, p%iUOpt1)) + matmul(m%dUdy(p%iUTight, p%iyOpt1), m%dYdu(p%iyOpt1, p%iUOpt1)) ! Group (3,3) m%Jac(p%iJ1, p%iJ1) = m%dUdu(p%iUOpt1, p%iUOpt1) + & - matmul(m%dUdy(p%iUOpt1, p%iyOpt1), & - m%dYdu(p%iyOpt1, p%iUOpt1)) + matmul(m%dUdy(p%iUOpt1, p%iyOpt1), m%dYdu(p%iyOpt1, p%iUOpt1)) end if ! Condition jacobian matrix before factoring @@ -934,111 +1299,133 @@ subroutine CalcJacobian(p, m, ErrStat, ErrMsg) call LAPACK_getrf(size(m%Jac, 1), size(m%Jac, 1), m%Jac, m%IPIV, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Reset Jacobian update countdown values - m%IterUntilUJac = p%NIter_UJac - m%StepsUntilUJac = p%NStep_UJac +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine +subroutine DumpMatrix(unit, filename, A, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: unit + character(*), intent(in) :: filename + real(R8Ki), intent(in) :: A(:, :) + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'DumpMatrix' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + call OpenBOutFile(unit, filename, ErrStat2, ErrMsg2) + write (unit) int(shape(A), B4Ki) + write (unit) pack(A, .true.) + close (unit) end subroutine -subroutine AddDeltaToStates(ModData, ModOrder, x, dx, xn) - use ModVar - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules - integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate - real(R8Ki), intent(in) :: dx(:) - real(R8Ki), intent(in) :: x(:) - real(R8Ki), intent(out) :: xn(:) - integer(IntKi) :: iMod, iIns - integer(IntKi) :: i, j, k, iGbl(3) +subroutine AddDeltaToStates(Mods, ModOrder, dx, x) + type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) + real(R8Ki), intent(in) :: dx(:) + real(R8Ki), intent(inout) :: x(:) + + character(*), parameter :: RoutineName = 'AddDeltaToStates' + integer(IntKi) :: iMod, iIns + integer(IntKi) :: i, j, k, ind(3) ! Loop through modules in order do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - ! Loop through variables - do j = 1, size(ModData(iMod)%Vars%x) - - ! Select based on field type - select case (ModData(iMod)%Vars%x(j)%Field) - case (VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) - ! Add delta x to x - xn(ModData(iMod)%Vars%x(j)%iGbl) = x(ModData(iMod)%Vars%x(j)%iGbl) + dx(ModData(iMod)%Vars%x(j)%iGbl) - case (VF_AngularDisp) - ! Add delta x to x and limit to between -2pi and 2pi - ! xn(ModData(iMod)%Vars%x(j)%iGbl) = mod(x(ModData(iMod)%Vars%x(j)%iGbl) + dx(ModData(iMod)%Vars%x(j)%iGbl), TwoPi_R8) - xn(ModData(iMod)%Vars%x(j)%iGbl) = x(ModData(iMod)%Vars%x(j)%iGbl) + dx(ModData(iMod)%Vars%x(j)%iGbl) - case (VF_Orientation) - ! Compose WM components - do k = 1, size(ModData(iMod)%Vars%x(j)%iGbl), 3 - iGbl = ModData(iMod)%Vars%x(j)%iGbl(k:k + 2) - xn(iGbl) = wm_compose(dx(iGbl), x(iGbl)) - end do - end select - + do j = 1, size(Mods(ModOrder(i))%Vars%x) + + associate (Var => Mods(ModOrder(i))%Vars%x(j)) + + ! Select based on field type + select case (Var%Field) + case (VF_Force, VF_Moment, VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) + ! Add delta x to x + x(Var%iGblSol) = x(Var%iGblSol) + dx(Var%iGblSol) + case (VF_AngularDisp) + ! Add delta x to x and limit to between -2pi and 2pi + ! x(ModData(i)%Vars%x(j)%iGblSol) = mod(x(ModData(i)%Vars%x(j)%iGblSol) + dx(ModData(i)%Vars%x(j)%iGblSol), TwoPi_R8) + x(Var%iGblSol) = x(Var%iGblSol) + dx(Var%iGblSol) + case (VF_Orientation) + ! Compose WM components (dx is in radians) + do k = 1, size(Var%iGblSol), 3 + ind = Var%iGblSol(k:k + 2) + x(ind) = wm_compose(4.0_R8Ki*tan(dx(ind)/4.0_R8Ki), x(ind)) + end do + end select + end associate end do end do + end subroutine -subroutine AddDeltaToInputs(ModData, ModOrder, u, du, un) - use ModVar - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules - integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate +subroutine AddDeltaToInputs(Mods, ModOrder, du, u) + type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) real(R8Ki), intent(in) :: du(:) - real(R8Ki), intent(in) :: u(:) - real(R8Ki), intent(out) :: un(:) - integer(IntKi) :: iMod, iIns - integer(IntKi) :: i, j, k, iGbl(3) + real(R8Ki), intent(inout) :: u(:) + + character(*), parameter :: RoutineName = 'AddDeltaToInputs' + integer(IntKi) :: i, j, k, ind(3) ! Loop through modules in order do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - ! Loop through variables - do j = 1, size(ModData(iMod)%Vars%u) - - ! Select based on field type - select case (ModData(iMod)%Vars%u(j)%Field) - case (VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) - ! Add delta u to u - un(ModData(iMod)%Vars%u(j)%iGbl) = u(ModData(iMod)%Vars%u(j)%iGbl) + du(ModData(iMod)%Vars%u(j)%iGbl) - case (VF_AngularDisp) - ! Add delta u to u and limit to between -2pi and 2pi - ! un(ModData(iMod)%Vars%u(j)%iGbl) = mod(u(ModData(iMod)%Vars%u(j)%iGbl) + du(ModData(iMod)%Vars%u(j)%iGbl), TwoPi_R8) - un(ModData(iMod)%Vars%u(j)%iGbl) = u(ModData(iMod)%Vars%u(j)%iGbl) + du(ModData(iMod)%Vars%u(j)%iGbl) - case (VF_Orientation) - ! Compose WM components - do k = 1, size(ModData(iMod)%Vars%u(j)%iGbl), 3 - iGbl = ModData(iMod)%Vars%u(j)%iGbl(k:k + 2) - un(iGbl) = wm_compose(du(iGbl), u(iGbl)) - end do - end select + do j = 1, size(Mods(ModOrder(i))%Vars%u) + + associate (Var => Mods(ModOrder(i))%Vars%u(j)) + + ! If this is not a solve variable, cycle + if (iand(Var%Flags, VF_Solve) == 0) cycle + + ! Select based on field type + select case (Var%Field) + case (VF_Force, VF_Moment, VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) + ! Add delta u to u + u(Var%iGblSol) = u(Var%iGblSol) + du(Var%iGblSol) + case (VF_AngularDisp) + ! Add delta u to u and limit to between -2pi and 2pi + ! un(Var%iGblSol) = mod(u(Var%iGblSol) + du(Var%iGblSol), TwoPi_R8) + u(Var%iGblSol) = u(Var%iGblSol) + du(Var%iGblSol) + case (VF_Orientation) + ! Compose WM components (du is in radians) + do k = 1, size(Var%iGblSol), 3 + ind = Var%iGblSol(k:k + 2) + u(ind) = wm_compose(4.0_R8Ki*tan(du(ind)/4.0_R8Ki), u(ind)) + end do + end select + end associate end do end do end subroutine -subroutine TransferFromModules(ModOrder, ModData, this_state, T, x, u, y) - integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate +subroutine PackModuleStates(ModData, this_state, T, x) type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules integer(IntKi), intent(in) :: this_state !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(R8Ki), allocatable, optional, intent(inout) :: x(:), u(:), y(:) - integer(IntKi) :: i, iMod, iIns + real(R8Ki), allocatable, optional, intent(inout) :: x(:) + integer(IntKi) :: ii, j + ! Must support all Tight Coupling modules if (present(x)) then - do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - select case (ModData(iMod)%ID) + do j = 1, size(ModData) + ii = ModData(j)%Ins + select case (ModData(j)%ID) case (Module_ED) call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) - x(T%ED%p%Vars%ixg) = T%ED%m%Vals%x + call XferLocToGbl1D(ModData(j)%ixs, T%ED%m%Vals%x, x) case (Module_BD) - ! BD_PackStateValues(BD%p(iIns), BD%x(this_state, iIns), BD%m(iIns)%Vals%x) - ! x(BD%p%Vars%ix) = BD%m%Vals%x + call BD_PackStateValues(T%BD%p(ii), T%BD%x(ii, this_state), T%BD%m(ii)%Vals%x) + call XferLocToGbl1D(ModData(j)%ixs, T%BD%m(ii)%Vals%x, x) case (Module_SD) ! call SD_PackStateValues(SD%p, SD%x(this_state), SD%m%Vals%x) ! x(SD%p%Vars%ix) = SD%m%Vals%x @@ -1046,187 +1433,126 @@ subroutine TransferFromModules(ModOrder, ModData, this_state, T, x, u, y) end do end if - if (present(u)) then - do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - select case (ModData(iMod)%ID) +end subroutine + +subroutine UnpackModuleStates(ModData, ModOrder, this_state, T, x) + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), intent(inout) :: x(:) + integer(IntKi) :: j + + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) - u(T%ED%p%Vars%iug) = T%ED%m%Vals%u + call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) + call XferGblToLoc1D(Mod%ixs, x, T%ED%m%Vals%x) + call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(this_state)) case (Module_BD) - ! BD_PackInputValues(BD%p(iIns), BD%Input(iIns), BD%m(iIns)%Vals%u) - ! u(BD%p%Vars%iu) = BD%m%Vals%u + call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%m(Mod%Ins)%Vals%x) + call XferGblToLoc1D(Mod%ixs, x, T%BD%m(Mod%Ins)%Vals%x) + call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, this_state)) case (Module_SD) - ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) - ! u(SD%p%Vars%iu) = SD%m%Vals%u + ! call SD_UnpackStateValues(SD%p, x(SD%p%Vars%ix), SD%x(this_state)) end select + end associate + end do +end subroutine + +! PackModuleInputs packs input values from Option 1 modules +subroutine PackModuleInputs(ModData, ModOrder, T, u, u_tmp) + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), optional, intent(inout) :: u(:), u_tmp(:) + integer(IntKi) :: j + + if (present(u)) then + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) + case (Module_BD) + call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) + call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u) + case (Module_SD) + ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) + ! u(SD%p%Vars%iu) = SD%m%Vals%u + end select + end associate end do end if - if (present(y)) then - do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - select case (ModData(iMod)%ID) - case (Module_ED) - call ED_PackOutputValues(T%ED%p, T%ED%y, T%ED%m%Vals%y) - y(T%ED%p%Vars%iyg) = T%ED%m%Vals%y - case (Module_BD) - ! BD_PackOutputValues(BD%p(iIns), BD%y(iIns), BD%m(iIns)%Vals%y) - ! y(BD%p%Vars%iy) = BD%m%Vals%y - case (Module_SD) - ! call SD_PackOutputValues(SD%p, SD%y, SD%m%Vals%y) - ! y(SD%p%Vars%iy) = SD%m%Vals%y - end select + if (present(u_tmp)) then + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%u, T%ED%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u_tmp) + case (Module_BD) + call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%u(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) + call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u_tmp) + case (Module_SD) + ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) + ! u(SD%p%Vars%iu) = SD%m%Vals%u + end select + end associate end do end if - - ! if (present(dxdt)) then - ! do i = 1, size(ModOrder) - ! iMod = ModOrder(i) - ! iIns = ModData(iMod)%Instance - ! select case (ModData(iMod)%ID) - ! case (Module_ED) - ! call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) - ! dxdt(T%ED%p%Vars%ixg) = T%ED%m%Vals%dxdt - ! case (Module_BD) - ! ! BD_PackStateValues(BD%p(iIns), BD%dxdt(iIns), BD%m(iIns)%Vals%dxdt) - ! ! dxdt(BD%p%Vars%ix) = BD%m%Vals%dxdt - ! case (Module_SD) - ! ! call SD_PackStateValues(SD%p, SD%dxdt, SD%m%Vals%dxdt) - ! ! dxdt(SD%p%Vars%ix) = SD%m%Vals%dxdt - ! end select - ! end do - ! end if - - ! if (present(dYdx)) then - ! do i = 1, size(ModOrder) - ! iMod = ModOrder(i) - ! iIns = ModData(iMod)%Instance - ! select case (ModData(iMod)%ID) - ! case (Module_ED) - ! dYdx(T%ED%p%Vars%iyg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dYdx - ! case (Module_BD) - ! ! dYdx(BD%p%Vars%iy, BD%p%Vars%ix) = BD%m%Vals%dYdx - ! case (Module_SD) - ! ! dYdx(SD%p%Vars%iy, SD%p%Vars%ix) = SD%m%Vals%dYdx - ! end select - ! end do - ! end if - - ! if (present(dXdx)) then - ! do i = 1, size(ModOrder) - ! iMod = ModOrder(i) - ! iIns = ModData(iMod)%Instance - ! select case (ModData(iMod)%ID) - ! case (Module_ED) - ! dXdx(T%ED%p%Vars%ixg, T%ED%p%Vars%ixg) = T%ED%m%Vals%dXdx - ! case (Module_BD) - ! ! dXdx(BD%p%Vars%ix, BD%p%Vars%ix) = BD%m%Vals%dXdx - ! case (Module_SD) - ! ! dXdx(SD%p%Vars%ix, SD%p%Vars%ix) = SD%m%Vals%dXdx - ! end select - ! end do - ! end if - - ! if (present(dYdu)) then - ! do i = 1, size(ModOrder) - ! iMod = ModOrder(i) - ! iIns = ModData(iMod)%Instance - ! select case (ModData(iMod)%ID) - ! case (Module_ED) - ! dYdu(T%ED%p%Vars%iyg, T%ED%p%Vars%iug) = T%ED%m%Vals%dYdu - ! case (Module_BD) - ! ! dYdu(BD%p%Vars%iy, BD%p%Vars%iu) = BD%m%Vals%dYdu - ! case (Module_SD) - ! ! dYdu(SD%p%Vars%iy, SD%p%Vars%iu) = SD%m%Vals%dYdu - ! end select - ! end do - ! end if - - ! if (present(dXdu)) then - ! do i = 1, size(ModOrder) - ! iMod = ModOrder(i) - ! iIns = ModData(iMod)%Instance - ! select case (ModData(iMod)%ID) - ! case (Module_ED) - ! dXdu(T%ED%p%Vars%ixg, T%ED%p%Vars%iug) = T%ED%m%Vals%dXdu - ! case (Module_BD) - ! ! dXdu(BD%p%Vars%ix, BD%p%Vars%iu) = BD%m%Vals%dXdu - ! case (Module_SD) - ! ! dXdu(SD%p%Vars%ix, SD%p%Vars%iu) = SD%m%Vals%dXdu - ! end select - ! end do - ! end if - end subroutine -subroutine TransferToModules(ModOrder, ModData, this_state, T, x, u) - integer(IntKi), intent(in) :: ModOrder(:) !< Array of module indices to evaluate - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules - integer(IntKi), intent(in) :: this_state !< State index - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(R8Ki), allocatable, optional, intent(inout) :: x(:), u(:) - integer(IntKi) :: i, iMod, iIns - - if (present(x)) then - do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - select case (ModData(iMod)%ID) - case (Module_ED) - call ED_UnpackStateValues(T%ED%p, x(T%ED%p%Vars%ixg), T%ED%x(this_state)) - case (Module_BD) - ! BD_UnpackStateValues(BD%p(iIns), x(BD%p%Vars%ix), BD%x(this_state, iIns)) - case (Module_SD) - ! call SD_UnpackStateValues(SD%p, x(SD%p%Vars%ix), SD%x(this_state)) - end select - end do - end if +! PackModuleInputs packs input values from Option 1 modules +subroutine UnpackModuleInputs(ModData, ModOrder, T, u) + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), intent(in) :: u(:) + integer(IntKi) :: j - if (present(u)) then - do i = 1, size(ModOrder) - iMod = ModOrder(i) - iIns = ModData(iMod)%Instance - select case (ModData(iMod)%ID) + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) case (Module_ED) - call ED_UnpackInputValues(T%ED%p, u(T%ED%p%Vars%iug), T%ED%Input(1)) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%ED%m%Vals%u) + call ED_UnpackInputValues(T%ED%p, T%ED%m%Vals%u, T%ED%Input(1)) case (Module_BD) - ! BD_UnpackInputValues(BD%p(iIns), u(BD%p%Vars%iu), BD%Input(1, iIns)) + call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%BD%m(Mod%Ins)%Vals%u) + call BD_UnpackInputValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u, T%BD%Input(1, Mod%Ins)) case (Module_SD) ! call SD_UnpackInputValues(SD%p, u(SD%p%Vars%iu), SD%Input(1)) end select - end do - end if + end associate + end do end subroutine -subroutine WriteOutputToFile(n_t_global, t_global, T, ErrStat, ErrMsg) - - integer(IntKi), intent(in) :: n_t_global !< Current global time step - real(DbKi), intent(in) :: t_global !< Current global time +! PackModuleOutputs packs output values from Option 1 modules +subroutine PackModuleOutputs(ModData, ModOrder, T, y) + type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + integer(IntKi), intent(in) :: ModOrder(:) type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), intent(inout) :: y(:) + integer(IntKi) :: j - character(*), parameter :: RoutineName = 'WriteOutputToFile' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - ! If output requested for this step, time-series channel data to glue-code output file - if (T%y_FAST%WriteThisStep) then - ! call WrOutputLine(t_global, T%p_FAST, T%y_FAST, T%IfW%y%WriteOutput, & - ! T%OpFM%y%WriteOutput, T%ED%y%WriteOutput, & - ! T%AD%y, T%SrvD%y%WriteOutput, T%SeaSt%y%WriteOutput, & - ! T%HD%y%WriteOutput, T%SD%y%WriteOutput, T%ExtPtfm%y%WriteOutput, & - ! T%MAP%y%WriteOutput, T%FEAM%y%WriteOutput, T%MD%y%WriteOutput, & - ! T%Orca%y%WriteOutput, T%IceF%y%WriteOutput, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) - ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + case (Module_ED) + call ED_PackOutputValues(T%ED%p, T%ED%y, T%ED%m%Vals%y) + call XferLocToGbl1D(Mod%iys, T%ED%m%Vals%y, y) + case (Module_BD) + call BD_PackOutputValues(T%BD%p(Mod%Ins), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins)%Vals%y) + call XferLocToGbl1D(Mod%iys, T%BD%m(Mod%Ins)%Vals%y, y) + end select + end associate + end do end subroutine From f70158e4540a72b65654fb769c774a91563b8908 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 17 Aug 2023 11:33:57 +0000 Subject: [PATCH 12/61] Tight Coupling working with BeamDyn! --- modules/elastodyn/src/ElastoDyn.f90 | 2 + modules/nwtc-library/src/ModVar.f90 | 26 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 110 +---- .../src/Registry_NWTC_Library.txt | 6 +- .../src/Registry_NWTC_Library_base.txt | 6 +- modules/openfast-library/src/FAST_Eval.f90 | 187 +++++--- .../openfast-library/src/FAST_Registry.txt | 9 +- modules/openfast-library/src/FAST_Types.f90 | 131 +++--- modules/openfast-library/src/Solver.f90 | 433 +++++++++--------- 9 files changed, 428 insertions(+), 482 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index dd2587fea8..1d687ed830 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -402,6 +402,8 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ! Continuous State Variables !---------------------------------------------------------------------------- + allocate(p%Vars%x(0)) + ! Add continuous state variables (translation and rotation) call MV_AddVar(p%Vars%x, 'PlatformSurge', VF_TransDisp, & iUsr=[DOF_Sg], & diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 2a8f956679..877a139ecd 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -459,7 +459,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference integer(IntKi) :: i, j, ind(3) real(R8Ki) :: DeltaWM(3) - + ! Loop through variables do i = 1, size(VarAry) @@ -525,19 +525,12 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat = ErrID_None ErrMsg = '' - ! Populate ModuleDataType derived type - ModData = ModDataType(ID=ModID, Abbr=ModAbbr, Ins=Instance, DT=ModDT, Vars=Vars) + ! If module array hasn't been allocated, allocate with zero size + if (.not. allocated(ModAry)) allocate (ModAry(0)) - ! Allocate mapping index with zero length - call AllocAry(ModData%iMapsOpt1, 0, "ModData%iMapsOpt1", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AllocAry(ModData%iMapsOpt2, 0, "ModData%iMapsOpt2", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call AllocAry(ModData%iMapsAll, 0, "ModData%iMapsAll", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! Populate ModuleDataType derived type + ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & + Ins=Instance, DT=ModDT, Vars=Vars) !---------------------------------------------------------------------------- ! Calculate Module Substepping @@ -573,11 +566,8 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ! Add module data to array !---------------------------------------------------------------------------- - if (allocated(ModAry)) then - ModAry = [ModAry, ModData] - else - ModAry = [ModData] - end if + ModAry = [ModAry, ModData] + end subroutine subroutine MV_AddMeshVar(VarAry, Name, Fields, Nodes, Flags, Perturbs, Active) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index b383f306a1..dea8918652 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -159,6 +159,7 @@ MODULE NWTC_Library_Types ! ======================= ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] INTEGER(IntKi) :: ID = 0 !< [-] character(ChanLen) :: Abbr !< [-] INTEGER(IntKi) :: Ins = 0 !< [-] @@ -168,9 +169,6 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMapsOpt1 !< array of mapping indices where this module is the input [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMapsOpt2 !< array of mapping indices where this module is the input [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iMapsAll !< array of mapping indices where this module is the input [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] END TYPE ModDataType ! ======================= @@ -1773,6 +1771,7 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' ErrStat = ErrID_None ErrMsg = '' + DstModDataTypeData%Idx = SrcModDataTypeData%Idx DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr DstModDataTypeData%Ins = SrcModDataTypeData%Ins @@ -1815,42 +1814,6 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, end if DstModDataTypeData%iys = SrcModDataTypeData%iys end if - if (allocated(SrcModDataTypeData%iMapsOpt1)) then - LB(1:1) = lbound(SrcModDataTypeData%iMapsOpt1) - UB(1:1) = ubound(SrcModDataTypeData%iMapsOpt1) - if (.not. allocated(DstModDataTypeData%iMapsOpt1)) then - allocate(DstModDataTypeData%iMapsOpt1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iMapsOpt1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iMapsOpt1 = SrcModDataTypeData%iMapsOpt1 - end if - if (allocated(SrcModDataTypeData%iMapsOpt2)) then - LB(1:1) = lbound(SrcModDataTypeData%iMapsOpt2) - UB(1:1) = ubound(SrcModDataTypeData%iMapsOpt2) - if (.not. allocated(DstModDataTypeData%iMapsOpt2)) then - allocate(DstModDataTypeData%iMapsOpt2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iMapsOpt2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iMapsOpt2 = SrcModDataTypeData%iMapsOpt2 - end if - if (allocated(SrcModDataTypeData%iMapsAll)) then - LB(1:1) = lbound(SrcModDataTypeData%iMapsAll) - UB(1:1) = ubound(SrcModDataTypeData%iMapsAll) - if (.not. allocated(DstModDataTypeData%iMapsAll)) then - allocate(DstModDataTypeData%iMapsAll(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iMapsAll.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModDataTypeData%iMapsAll = SrcModDataTypeData%iMapsAll - end if DstModDataTypeData%Vars => SrcModDataTypeData%Vars end subroutine @@ -1872,15 +1835,6 @@ subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) if (allocated(ModDataTypeData%iys)) then deallocate(ModDataTypeData%iys) end if - if (allocated(ModDataTypeData%iMapsOpt1)) then - deallocate(ModDataTypeData%iMapsOpt1) - end if - if (allocated(ModDataTypeData%iMapsOpt2)) then - deallocate(ModDataTypeData%iMapsOpt2) - end if - if (allocated(ModDataTypeData%iMapsAll)) then - deallocate(ModDataTypeData%iMapsAll) - end if nullify(ModDataTypeData%Vars) end subroutine @@ -1890,6 +1844,7 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Idx) call RegPack(Buf, InData%ID) call RegPack(Buf, InData%Abbr) call RegPack(Buf, InData%Ins) @@ -1911,21 +1866,6 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%iys), ubound(InData%iys)) call RegPack(Buf, InData%iys) end if - call RegPack(Buf, allocated(InData%iMapsOpt1)) - if (allocated(InData%iMapsOpt1)) then - call RegPackBounds(Buf, 1, lbound(InData%iMapsOpt1), ubound(InData%iMapsOpt1)) - call RegPack(Buf, InData%iMapsOpt1) - end if - call RegPack(Buf, allocated(InData%iMapsOpt2)) - if (allocated(InData%iMapsOpt2)) then - call RegPackBounds(Buf, 1, lbound(InData%iMapsOpt2), ubound(InData%iMapsOpt2)) - call RegPack(Buf, InData%iMapsOpt2) - end if - call RegPack(Buf, allocated(InData%iMapsAll)) - if (allocated(InData%iMapsAll)) then - call RegPackBounds(Buf, 1, lbound(InData%iMapsAll), ubound(InData%iMapsAll)) - call RegPack(Buf, InData%iMapsAll) - end if call RegPack(Buf, associated(InData%Vars)) if (associated(InData%Vars)) then call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) @@ -1946,6 +1886,8 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Idx) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%ID) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Abbr) @@ -2000,48 +1942,6 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) call RegUnpack(Buf, OutData%iys) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iMapsOpt1)) deallocate(OutData%iMapsOpt1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iMapsOpt1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iMapsOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iMapsOpt1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iMapsOpt2)) deallocate(OutData%iMapsOpt2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iMapsOpt2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iMapsOpt2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iMapsOpt2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iMapsAll)) deallocate(OutData%iMapsAll) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iMapsAll(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iMapsAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iMapsAll) - if (RegCheckErr(Buf, RoutineName)) return - end if if (associated(OutData%Vars)) deallocate(OutData%Vars) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index b379b8971e..3dda455bb6 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -105,7 +105,8 @@ typedef ^ ^ R8Ki dXdx :: - - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ModDataType IntKi ID - 0 - "" - +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "" - typedef ^ ^ character(ChanLen) Abbr - - - "" - typedef ^ ^ IntKi Ins - 0 - "" - typedef ^ ^ R8Ki DT - 0 - "" - @@ -114,9 +115,6 @@ typedef ^ ^ IntKi SolveOption - 0 - typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - -typedef ^ ^ IntKi iMapsOpt1 : - - "array of mapping indices where this module is the input" - -typedef ^ ^ IntKi iMapsOpt2 : - - "array of mapping indices where this module is the input" - -typedef ^ ^ IntKi iMapsAll : - - "array of mapping indices where this module is the input" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - # This file defines types that may be used from the NWTC_Library diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 47fc39a6d8..0f5721a0fc 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -105,7 +105,8 @@ typedef ^ ^ R8Ki dXdx :: - - typedef ^ ^ R8Ki dYdu :: - - "" - typedef ^ ^ R8Ki dXdu :: - - "" - -typedef ^ ModDataType IntKi ID - 0 - "" - +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "" - typedef ^ ^ character(ChanLen) Abbr - - - "" - typedef ^ ^ IntKi Ins - 0 - "" - typedef ^ ^ R8Ki DT - 0 - "" - @@ -114,7 +115,4 @@ typedef ^ ^ IntKi SolveOption - 0 - typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - -typedef ^ ^ IntKi iMapsOpt1 : - - "array of mapping indices where this module is the input" - -typedef ^ ^ IntKi iMapsOpt2 : - - "array of mapping indices where this module is the input" - -typedef ^ ^ IntKi iMapsAll : - - "array of mapping indices where this module is the input" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 8587d6ddb1..363fc794a0 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -200,10 +200,11 @@ logical function Failed() end function end subroutine -subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg) +subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_TC) type(ModDataType), intent(in) :: Mod !< Module data real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) integer(IntKi), intent(in) :: n_t_global !< Integer time step + real(R8Ki), optional, intent(in) :: x_TC(:) !< Tight coupling state array type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -236,11 +237,19 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg) case (Module_BD) - ! No update states for tight coupling modules + if (present(x_TC)) then + call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) + call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) + call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) + end if case (Module_ED) - ! No update states for tight coupling modules + if (present(x_TC)) then + call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) + call XferGblToLoc1D(Mod%ixs, x_TC, T%ED%m%Vals%x) + call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(STATE_PRED)) + end if ! case (Module_ExtPtfm) ! case (Module_FEAM) @@ -284,8 +293,8 @@ logical function Failed() end function end subroutine -subroutine FAST_InitMappings(Mappings, T, ErrStat, ErrMsg) - type(TC_MeshMapType), intent(inout) :: Mappings(:) +subroutine FAST_InitMappings(Maps, T, ErrStat, ErrMsg) + type(TC_MappingType), intent(inout) :: Maps(:) type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -293,35 +302,94 @@ subroutine FAST_InitMappings(Mappings, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_InputSolve' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j - integer(IntKi) :: iiu, iiy + integer(IntKi) :: i + integer(IntKi) :: DstIns, SrcIns ErrStat = ErrID_None ErrMsg = '' ! Loop through mappings - do j = 1, size(Mappings) + do i = 1, size(Maps) ! Get output and input module instance indices - iiy = Mappings(j)%SrcModInst - iiu = Mappings(j)%DstModInst + SrcIns = Maps(i)%SrcIns + DstIns = Maps(i)%DstIns ! Select by mapping key - select case (Mappings(j)%Key) + select case (Maps(i)%Key) case ('ED BladeRoot -> BD RootMotion') - call MeshMapCreate(T%ED%y%BladeRootMotion(iiu), T%BD%Input(1, iiu)%RootMotion, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + call MeshMapCreate(T%ED%y%BladeRootMotion(DstIns), T%BD%Input(1, DstIns)%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + call MeshCopy(T%BD%Input(1, DstIns)%RootMotion, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return case ('BD ReactionForce -> ED HubLoad') - call MeshMapCreate(T%BD%y(iiu)%ReactionForce, T%ED%Input(1)%HubPtLoad, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + call MeshMapCreate(T%BD%y(DstIns)%ReactionForce, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return ! Copy temporary mesh to transfer reaction force because actual mesh is needed to sum multiple forces - call MeshCopy(T%ED%Input(1)%HubPtLoad, Mappings(j)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Mappings(j)%Key, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_MapOutputs(Mod, Maps, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_TransferOutputs' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + integer(IntKi) :: DstIns, SrcIns + + ! Loop through mappings that use this module's outputs + do i = 1, size(Maps) + + ! If map doesn't apply to this module, cycle + if (Mod%Idx /= Maps(i)%SrcModIdx) cycle + + ! Get source and destination module instances + SrcIns = Maps(i)%SrcIns + DstIns = Maps(i)%DstIns + + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Maps(i)%Key) + + case ('ED BladeRoot -> BD RootMotion') + + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(DstIns), Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + ! + + case ('BD ReactionForce -> ED HubLoad') + + ! u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations + call Transfer_Point_to_Point(T%BD%y(SrcIns)%ReactionForce, Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, SrcIns)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return + ! u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force + ! u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) return end select + ! Set flag indicating that mapping has been updated + Maps(i)%Updated = .true. + end do contains @@ -331,9 +399,9 @@ logical function Failed() end function end subroutine -subroutine FAST_InputSolve(Mod, Mappings, Dst, T, ErrStat, ErrMsg) +subroutine FAST_UpdateInputs(Mod, Maps, Dst, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: Mod !< Module data - type(TC_MeshMapType), intent(inout) :: Mappings(:) + type(TC_MappingType), intent(inout) :: Maps(:) integer(IntKi), intent(in) :: Dst type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -342,10 +410,11 @@ subroutine FAST_InputSolve(Mod, Mappings, Dst, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_InputSolve' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j, k - integer(IntKi) :: iiu, iiy + integer(IntKi) :: i, j, k + integer(IntKi) :: DstIns, SrcIns type(ED_InputType), pointer :: u_ED type(BD_InputType), pointer :: u_BD + logical :: ED_ResetHubPtLoad ErrStat = ErrID_None ErrMsg = '' @@ -356,7 +425,6 @@ subroutine FAST_InputSolve(Mod, Mappings, Dst, T, ErrStat, ErrMsg) return end if - ! Initialize module values before transfering select case (Mod%ID) case (Module_BD) @@ -368,8 +436,11 @@ subroutine FAST_InputSolve(Mod, Mappings, Dst, T, ErrStat, ErrMsg) u_BD => T%BD%u(Mod%Ins) end select - u_BD%DistrLoad%Force = 0.0_ReKi - u_BD%DistrLoad%Moment = 0.0_ReKi + ! u_BD%DistrLoad%Force = 0.0_ReKi + ! u_BD%DistrLoad%Moment = 0.0_ReKi + + ! u_BD%PointLoad%Force = 0.0_ReKi + ! u_BD%PointLoad%Moment = 0.0_ReKi case (Module_ED) @@ -380,50 +451,54 @@ subroutine FAST_InputSolve(Mod, Mappings, Dst, T, ErrStat, ErrMsg) u_ED => T%ED%u end select - u_ED%TowerPtLoads%Force = 0.0_ReKi - u_ED%TowerPtLoads%Moment = 0.0_ReKi + ED_ResetHubPtLoad = .true. - u_ED%NacelleLoads%Force = 0.0_ReKi - u_ED%NacelleLoads%Moment = 0.0_ReKi + ! u_ED%NacelleLoads%Force = 0.0_ReKi + ! u_ED%NacelleLoads%Moment = 0.0_ReKi - u_ED%TwrAddedMass = 0.0_ReKi - u_ED%PtfmAddedMass = 0.0_ReKi + ! u_ED%TowerPtLoads%Force = 0.0_ReKi + ! u_ED%TowerPtLoads%Moment = 0.0_ReKi - u_ED%HubPtLoad%Force = 0.0_ReKi - u_ED%HubPtLoad%Moment = 0.0_ReKi + ! u_ED%TwrAddedMass = 0.0_ReKi + ! u_ED%PtfmAddedMass = 0.0_ReKi end select - ! Loop through mapping index array - do k = 1, size(Mod%iMapsOpt1) + ! Loop through mappings that set this module's inputs + do i = 1, size(Maps) + + ! If mapping hasn't been updated, cycle + if (.not. Maps(i)%Updated) cycle - associate (Map => Mappings(Mod%iMapsOpt1(k))) + ! If map doesn't apply to this module, cycle + if (Mod%Idx /= Maps(i)%DstModIdx) cycle - ! Get source and destination module instances - iiy = Map%SrcModInst - iiu = Map%DstModInst + ! Get source and destination module instances + SrcIns = Maps(i)%SrcIns + DstIns = Maps(i)%DstIns - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Map%Key) + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Maps(i)%Key) - case ('ED BladeRoot -> BD RootMotion') + case ('ED BladeRoot -> BD RootMotion') - call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(iiu), u_BD%RootMotion, Map%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + call MeshCopy(Maps(i)%MeshTmp, u_BD%RootMotion, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - case ('BD ReactionForce -> ED HubLoad') + case ('BD ReactionForce -> ED HubLoad') - ! u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations - call Transfer_Point_to_Point(T%BD%y(iiy)%ReactionForce, Map%MeshTmp, Map%MeshMap, & - ErrStat2, ErrMsg2, T%BD%Input(1, iiy)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return - u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Map%MeshTmp%Force - u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Map%MeshTmp%Moment + if (ED_ResetHubPtLoad) then + u_ED%HubPtLoad%Force = 0.0_ReKi + u_ED%HubPtLoad%Moment = 0.0_ReKi + ED_ResetHubPtLoad = .false. + end if - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Map%Key, ErrStat, ErrMsg, RoutineName) - return - end select + u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force + u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment - end associate + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select end do contains @@ -436,7 +511,7 @@ logical function Failed() subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMsg, dUdu, dUdy) type(ModDataType), intent(in) :: ModData(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) - type(TC_MeshMapType), intent(inout) :: Mappings(:) + type(TC_MappingType), intent(inout) :: Mappings(:) type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -458,8 +533,8 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMs if (all(Mappings(j)%DstModIdx /= ModOrder) .and. all(Mappings(j)%SrcModIdx /= ModOrder)) cycle ! Get input/output module instances - iiu = Mappings(j)%DstModInst - iiy = Mappings(j)%SrcModInst + iiu = Mappings(j)%DstIns + iiy = Mappings(j)%SrcIns ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) select case (Mappings(j)%Key) @@ -487,7 +562,7 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMs contains subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) - type(TC_MeshMapType), intent(inout) :: M !< Mapping + type(TC_MappingType), intent(inout) :: M !< Mapping type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data @@ -508,7 +583,7 @@ subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) end subroutine subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) - type(TC_MeshMapType), intent(inout) :: M !< Mapping + type(TC_MappingType), intent(inout) :: M !< Mapping type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index cec2504415..fa598b4050 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -91,7 +91,7 @@ typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - # ..... Tight Coupling Generalized Alpha Solver Data ............. # Mapping Type -typedef ^ TC_MeshMapType character(VarNameLen) Key - - - "Mapping Key" - +typedef ^ TC_MappingType character(VarNameLen) Key - - - "Mapping Key" - typedef ^ ^ character(VarNameLen) SrcMeshName - - - "source mesh name" - typedef ^ ^ character(VarNameLen) DstMeshName - - - "destination mesh name" - typedef ^ ^ character(VarNameLen) SrcDispMeshName - '' - "source displacement mesh name [if IsLoad=true]" - @@ -100,8 +100,8 @@ typedef ^ ^ IntKi SrcModID - - - typedef ^ ^ IntKi DstModID - - - "Input module ID" - typedef ^ ^ IntKi SrcModIdx - - - "Output module index in ModData array" - typedef ^ ^ IntKi DstModIdx - - - "Input module index in ModData array" - -typedef ^ ^ IntKi SrcModInst - - - "Output module Instance" - -typedef ^ ^ IntKi DstModInst - - - "Input module Instance" - +typedef ^ ^ IntKi SrcIns - - - "Output module Instance" - +typedef ^ ^ IntKi DstIns - - - "Input module Instance" - typedef ^ ^ IntKi SrcVarIdx : - - "motion variable index" - typedef ^ ^ IntKi DstVarIdx : - - "motion variable index" - typedef ^ ^ IntKi SrcDispVarIdx - - - "source displacement var index [if IsLoad=true]" - @@ -109,6 +109,7 @@ typedef ^ ^ IntKi DstDispVarIdx - - - typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from output variable to input variable" - typedef ^ ^ logical IsLoad - - - "Flag indicating if this is a load or motion mapping" - +typedef ^ ^ logical Updated - - - "Flag indicating if this mesh has been updated" - # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - @@ -173,7 +174,7 @@ typedef ^ ^ R8Ki dq :: - - typedef ^ ^ R8Ki dx : - - "Change in x" - typedef ^ ^ R8Ki du : - - "" - typedef ^ ^ R8Ki UDiff : - - "" - -typedef ^ ^ TC_MeshMapType Mappings : - - "Array of mesh mappings in solver" - +typedef ^ ^ TC_MappingType Mappings : - - "Array of mesh mappings in solver" - typedef ^ ^ IntKi DebugUnit - - - "Unit number to write debug info" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 51c9ae6512..01318fab50 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -109,8 +109,8 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_phase !< phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] END TYPE FAST_VTK_ModeShapeType ! ======================= -! ========= TC_MeshMapType ======= - TYPE, PUBLIC :: TC_MeshMapType +! ========= TC_MappingType ======= + TYPE, PUBLIC :: TC_MappingType character(VarNameLen) :: Key !< Mapping Key [-] character(VarNameLen) :: SrcMeshName !< source mesh name [-] character(VarNameLen) :: DstMeshName !< destination mesh name [-] @@ -120,8 +120,8 @@ MODULE FAST_Types INTEGER(IntKi) :: DstModID = 0_IntKi !< Input module ID [-] INTEGER(IntKi) :: SrcModIdx = 0_IntKi !< Output module index in ModData array [-] INTEGER(IntKi) :: DstModIdx = 0_IntKi !< Input module index in ModData array [-] - INTEGER(IntKi) :: SrcModInst = 0_IntKi !< Output module Instance [-] - INTEGER(IntKi) :: DstModInst = 0_IntKi !< Input module Instance [-] + INTEGER(IntKi) :: SrcIns = 0_IntKi !< Output module Instance [-] + INTEGER(IntKi) :: DstIns = 0_IntKi !< Input module Instance [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcVarIdx !< motion variable index [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstVarIdx !< motion variable index [-] INTEGER(IntKi) :: SrcDispVarIdx = 0_IntKi !< source displacement var index [if IsLoad=true] [-] @@ -129,7 +129,8 @@ MODULE FAST_Types TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from output variable to input variable [-] LOGICAL :: IsLoad = .false. !< Flag indicating if this is a load or motion mapping [-] - END TYPE TC_MeshMapType + LOGICAL :: Updated = .false. !< Flag indicating if this mesh has been updated [-] + END TYPE TC_MappingType ! ======================= ! ========= TC_ParameterType ======= TYPE, PUBLIC :: TC_ParameterType @@ -197,7 +198,7 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] - TYPE(TC_MeshMapType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] + TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] INTEGER(IntKi) :: DebugUnit = 0_IntKi !< Unit number to write debug info [-] END TYPE TC_MiscVarType ! ======================= @@ -1506,89 +1507,90 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) end if end subroutine -subroutine FAST_CopyTC_MeshMapType(SrcTC_MeshMapTypeData, DstTC_MeshMapTypeData, CtrlCode, ErrStat, ErrMsg) - type(TC_MeshMapType), intent(inout) :: SrcTC_MeshMapTypeData - type(TC_MeshMapType), intent(inout) :: DstTC_MeshMapTypeData +subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, CtrlCode, ErrStat, ErrMsg) + type(TC_MappingType), intent(inout) :: SrcTC_MappingTypeData + type(TC_MappingType), intent(inout) :: DstTC_MappingTypeData 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 = 'FAST_CopyTC_MeshMapType' + character(*), parameter :: RoutineName = 'FAST_CopyTC_MappingType' ErrStat = ErrID_None ErrMsg = '' - DstTC_MeshMapTypeData%Key = SrcTC_MeshMapTypeData%Key - DstTC_MeshMapTypeData%SrcMeshName = SrcTC_MeshMapTypeData%SrcMeshName - DstTC_MeshMapTypeData%DstMeshName = SrcTC_MeshMapTypeData%DstMeshName - DstTC_MeshMapTypeData%SrcDispMeshName = SrcTC_MeshMapTypeData%SrcDispMeshName - DstTC_MeshMapTypeData%DstDispMeshName = SrcTC_MeshMapTypeData%DstDispMeshName - DstTC_MeshMapTypeData%SrcModID = SrcTC_MeshMapTypeData%SrcModID - DstTC_MeshMapTypeData%DstModID = SrcTC_MeshMapTypeData%DstModID - DstTC_MeshMapTypeData%SrcModIdx = SrcTC_MeshMapTypeData%SrcModIdx - DstTC_MeshMapTypeData%DstModIdx = SrcTC_MeshMapTypeData%DstModIdx - DstTC_MeshMapTypeData%SrcModInst = SrcTC_MeshMapTypeData%SrcModInst - DstTC_MeshMapTypeData%DstModInst = SrcTC_MeshMapTypeData%DstModInst - if (allocated(SrcTC_MeshMapTypeData%SrcVarIdx)) then - LB(1:1) = lbound(SrcTC_MeshMapTypeData%SrcVarIdx) - UB(1:1) = ubound(SrcTC_MeshMapTypeData%SrcVarIdx) - if (.not. allocated(DstTC_MeshMapTypeData%SrcVarIdx)) then - allocate(DstTC_MeshMapTypeData%SrcVarIdx(LB(1):UB(1)), stat=ErrStat2) + DstTC_MappingTypeData%Key = SrcTC_MappingTypeData%Key + DstTC_MappingTypeData%SrcMeshName = SrcTC_MappingTypeData%SrcMeshName + DstTC_MappingTypeData%DstMeshName = SrcTC_MappingTypeData%DstMeshName + DstTC_MappingTypeData%SrcDispMeshName = SrcTC_MappingTypeData%SrcDispMeshName + DstTC_MappingTypeData%DstDispMeshName = SrcTC_MappingTypeData%DstDispMeshName + DstTC_MappingTypeData%SrcModID = SrcTC_MappingTypeData%SrcModID + DstTC_MappingTypeData%DstModID = SrcTC_MappingTypeData%DstModID + DstTC_MappingTypeData%SrcModIdx = SrcTC_MappingTypeData%SrcModIdx + DstTC_MappingTypeData%DstModIdx = SrcTC_MappingTypeData%DstModIdx + DstTC_MappingTypeData%SrcIns = SrcTC_MappingTypeData%SrcIns + DstTC_MappingTypeData%DstIns = SrcTC_MappingTypeData%DstIns + if (allocated(SrcTC_MappingTypeData%SrcVarIdx)) then + LB(1:1) = lbound(SrcTC_MappingTypeData%SrcVarIdx) + UB(1:1) = ubound(SrcTC_MappingTypeData%SrcVarIdx) + if (.not. allocated(DstTC_MappingTypeData%SrcVarIdx)) then + allocate(DstTC_MappingTypeData%SrcVarIdx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MeshMapTypeData%SrcVarIdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MappingTypeData%SrcVarIdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MeshMapTypeData%SrcVarIdx = SrcTC_MeshMapTypeData%SrcVarIdx + DstTC_MappingTypeData%SrcVarIdx = SrcTC_MappingTypeData%SrcVarIdx end if - if (allocated(SrcTC_MeshMapTypeData%DstVarIdx)) then - LB(1:1) = lbound(SrcTC_MeshMapTypeData%DstVarIdx) - UB(1:1) = ubound(SrcTC_MeshMapTypeData%DstVarIdx) - if (.not. allocated(DstTC_MeshMapTypeData%DstVarIdx)) then - allocate(DstTC_MeshMapTypeData%DstVarIdx(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTC_MappingTypeData%DstVarIdx)) then + LB(1:1) = lbound(SrcTC_MappingTypeData%DstVarIdx) + UB(1:1) = ubound(SrcTC_MappingTypeData%DstVarIdx) + if (.not. allocated(DstTC_MappingTypeData%DstVarIdx)) then + allocate(DstTC_MappingTypeData%DstVarIdx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MeshMapTypeData%DstVarIdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MappingTypeData%DstVarIdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_MeshMapTypeData%DstVarIdx = SrcTC_MeshMapTypeData%DstVarIdx + DstTC_MappingTypeData%DstVarIdx = SrcTC_MappingTypeData%DstVarIdx end if - DstTC_MeshMapTypeData%SrcDispVarIdx = SrcTC_MeshMapTypeData%SrcDispVarIdx - DstTC_MeshMapTypeData%DstDispVarIdx = SrcTC_MeshMapTypeData%DstDispVarIdx - call MeshCopy(SrcTC_MeshMapTypeData%MeshTmp, DstTC_MeshMapTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) + DstTC_MappingTypeData%SrcDispVarIdx = SrcTC_MappingTypeData%SrcDispVarIdx + DstTC_MappingTypeData%DstDispVarIdx = SrcTC_MappingTypeData%DstDispVarIdx + call MeshCopy(SrcTC_MappingTypeData%MeshTmp, DstTC_MappingTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call NWTC_Library_CopyMeshMapType(SrcTC_MeshMapTypeData%MeshMap, DstTC_MeshMapTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMap, DstTC_MappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstTC_MeshMapTypeData%IsLoad = SrcTC_MeshMapTypeData%IsLoad + DstTC_MappingTypeData%IsLoad = SrcTC_MappingTypeData%IsLoad + DstTC_MappingTypeData%Updated = SrcTC_MappingTypeData%Updated end subroutine -subroutine FAST_DestroyTC_MeshMapType(TC_MeshMapTypeData, ErrStat, ErrMsg) - type(TC_MeshMapType), intent(inout) :: TC_MeshMapTypeData +subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) + type(TC_MappingType), intent(inout) :: TC_MappingTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyTC_MeshMapType' + character(*), parameter :: RoutineName = 'FAST_DestroyTC_MappingType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(TC_MeshMapTypeData%SrcVarIdx)) then - deallocate(TC_MeshMapTypeData%SrcVarIdx) + if (allocated(TC_MappingTypeData%SrcVarIdx)) then + deallocate(TC_MappingTypeData%SrcVarIdx) end if - if (allocated(TC_MeshMapTypeData%DstVarIdx)) then - deallocate(TC_MeshMapTypeData%DstVarIdx) + if (allocated(TC_MappingTypeData%DstVarIdx)) then + deallocate(TC_MappingTypeData%DstVarIdx) end if - call MeshDestroy( TC_MeshMapTypeData%MeshTmp, ErrStat2, ErrMsg2) + call MeshDestroy( TC_MappingTypeData%MeshTmp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call NWTC_Library_DestroyMeshMapType(TC_MeshMapTypeData%MeshMap, ErrStat2, ErrMsg2) + call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackTC_MeshMapType(Buf, Indata) +subroutine FAST_PackTC_MappingType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(TC_MeshMapType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackTC_MeshMapType' + type(TC_MappingType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTC_MappingType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Key) call RegPack(Buf, InData%SrcMeshName) @@ -1599,8 +1601,8 @@ subroutine FAST_PackTC_MeshMapType(Buf, Indata) call RegPack(Buf, InData%DstModID) call RegPack(Buf, InData%SrcModIdx) call RegPack(Buf, InData%DstModIdx) - call RegPack(Buf, InData%SrcModInst) - call RegPack(Buf, InData%DstModInst) + call RegPack(Buf, InData%SrcIns) + call RegPack(Buf, InData%DstIns) call RegPack(Buf, allocated(InData%SrcVarIdx)) if (allocated(InData%SrcVarIdx)) then call RegPackBounds(Buf, 1, lbound(InData%SrcVarIdx), ubound(InData%SrcVarIdx)) @@ -1616,13 +1618,14 @@ subroutine FAST_PackTC_MeshMapType(Buf, Indata) call MeshPack(Buf, InData%MeshTmp) call NWTC_Library_PackMeshMapType(Buf, InData%MeshMap) call RegPack(Buf, InData%IsLoad) + call RegPack(Buf, InData%Updated) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackTC_MeshMapType(Buf, OutData) +subroutine FAST_UnPackTC_MappingType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(TC_MeshMapType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackTC_MeshMapType' + type(TC_MappingType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_MappingType' integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -1645,9 +1648,9 @@ subroutine FAST_UnPackTC_MeshMapType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstModIdx) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SrcModInst) + call RegUnpack(Buf, OutData%SrcIns) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DstModInst) + call RegUnpack(Buf, OutData%DstIns) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%SrcVarIdx)) deallocate(OutData%SrcVarIdx) call RegUnpack(Buf, IsAllocAssoc) @@ -1685,6 +1688,8 @@ subroutine FAST_UnPackTC_MeshMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%MeshMap) ! MeshMap call RegUnpack(Buf, OutData%IsLoad) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Updated) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2700,7 +2705,7 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if end if do i1 = LB(1), UB(1) - call FAST_CopyTC_MeshMapType(SrcTC_MiscVarTypeData%Mappings(i1), DstTC_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) + call FAST_CopyTC_MappingType(SrcTC_MiscVarTypeData%Mappings(i1), DstTC_MiscVarTypeData%Mappings(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do @@ -2801,7 +2806,7 @@ subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) LB(1:1) = lbound(TC_MiscVarTypeData%Mappings) UB(1:1) = ubound(TC_MiscVarTypeData%Mappings) do i1 = LB(1), UB(1) - call FAST_DestroyTC_MeshMapType(TC_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) + call FAST_DestroyTC_MappingType(TC_MiscVarTypeData%Mappings(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(TC_MiscVarTypeData%Mappings) @@ -2954,7 +2959,7 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) LB(1:1) = lbound(InData%Mappings) UB(1:1) = ubound(InData%Mappings) do i1 = LB(1), UB(1) - call FAST_PackTC_MeshMapType(Buf, InData%Mappings(i1)) + call FAST_PackTC_MappingType(Buf, InData%Mappings(i1)) end do end if call RegPack(Buf, InData%DebugUnit) @@ -3352,7 +3357,7 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) return end if do i1 = LB(1), UB(1) - call FAST_UnpackTC_MeshMapType(Buf, OutData%Mappings(i1)) ! Mappings + call FAST_UnpackTC_MappingType(Buf, OutData%Mappings(i1)) ! Mappings end do end if call RegUnpack(Buf, OutData%DebugUnit) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 650717c8fc..745b4003dc 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -36,11 +36,11 @@ module Solver contains -subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) +subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) type(TC_ParameterType), intent(inout) :: p !< Parameters type(TC_MiscVarType), intent(out) :: m !< Misc variables for optimization (not copied in glue code) - type(ModDataType), intent(inout) :: ModData(:) !< Solution variables from modules + type(ModDataType), intent(inout) :: Mods(:) !< Solution variables from modules integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -52,51 +52,51 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) integer(IntKi), allocatable :: iq(:), modIDs(:), vec1(:), vec2(:) logical :: isLoad logical, allocatable :: isLoadTight(:), isLoadOption1(:) - type(TC_MeshMapType) :: MeshMap + type(TC_MappingType) :: MeshMap !---------------------------------------------------------------------------- ! Module ordering for solve !---------------------------------------------------------------------------- ! Get array of module IDs - modIDs = [(ModData(i)%ID, i=1, size(ModData))] + modIDs = [(Mods(i)%ID, i=1, size(Mods))] ! Ordering array for all modules - p%iModAll = [pack([(i, i=1, size(ModData))], ModIDs == Module_SrvD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_AD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & - pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + p%iModAll = [pack([(i, i=1, size(Mods))], ModIDs == Module_SrvD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_AD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & + pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_SD)] ! Ordering array for tight coupling modules - p%iModTC = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & - pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + p%iModTC = [pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & + pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_SD)] ! Ordering array for Option 2 solve - p%iModOpt2 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & - pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_SD)] + p%iModOpt2 = [pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & + pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_SD)] ! Ordering array for Option 1 solve - p%iModOpt1 = [pack([(i, i=1, size(ModData))], ModIDs == Module_ED), & - pack([(i, i=1, size(ModData))], ModIDs == Module_BD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_SD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_ExtPtfm), & - pack([(i, i=1, size(ModData))], ModIDs == Module_HD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_Orca)] + p%iModOpt1 = [pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & + pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_SD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_ExtPtfm), & + pack([(i, i=1, size(Mods))], ModIDs == Module_HD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_Orca)] ! Ordering array for Option 1 modules that were not in Option 2 ! These modules need to do update states and calc output before Option 1 solve - p%iModOpt1US = [pack([(i, i=1, size(ModData))], ModIDs == Module_ExtPtfm), & - pack([(i, i=1, size(ModData))], ModIDs == Module_HD), & - pack([(i, i=1, size(ModData))], ModIDs == Module_Orca)] + p%iModOpt1US = [pack([(i, i=1, size(Mods))], ModIDs == Module_ExtPtfm), & + pack([(i, i=1, size(Mods))], ModIDs == Module_HD), & + pack([(i, i=1, size(Mods))], ModIDs == Module_Orca)] !---------------------------------------------------------------------------- ! Initialize mesh mappings (must be done before calculating global indices) !---------------------------------------------------------------------------- - call InitMeshMappings(m%Mappings, ModData, p%iModOpt1, p%iModOpt2, ErrStat2, ErrMsg2); if (Failed()) return + call Solver_DefineMappings(m%Mappings, Mods, ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Calculate Variable cateogries and global indices @@ -104,51 +104,51 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) !---------------------------------------------------------------------------- NumX = 0 - do i = 1, size(ModData) + do i = 1, size(Mods) vec1 = [(0, k=1, 0)] vec2 = [(0, k=1, 0)] - do j = 1, size(ModData(i)%Vars%x) - ModData(i)%Vars%x(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%x(j)%Field) - if (ModData(i)%Vars%x(j)%Cat == VC_Tight) then - ModData(i)%Vars%x(j)%iGblSol = [(NumX + k, k=1, ModData(i)%Vars%x(j)%Size)] - vec1 = [vec1, ModData(i)%Vars%x(j)%iLoc] - vec2 = [vec2, ModData(i)%Vars%x(j)%iGblSol] - NumX = NumX + ModData(i)%Vars%x(j)%Size + do j = 1, size(Mods(i)%Vars%x) + Mods(i)%Vars%x(j)%Cat = VarCategory(Mods(i)%ID, Mods(i)%Vars%x(j)%Field) + if (Mods(i)%Vars%x(j)%Cat == VC_Tight) then + Mods(i)%Vars%x(j)%iGblSol = [(NumX + k, k=1, Mods(i)%Vars%x(j)%Size)] + vec1 = [vec1, Mods(i)%Vars%x(j)%iLoc] + vec2 = [vec2, Mods(i)%Vars%x(j)%iGblSol] + NumX = NumX + Mods(i)%Vars%x(j)%Size end if end do - ModData(i)%ixs = reshape([vec1, vec2], [size(vec1), 2]) + Mods(i)%ixs = reshape([vec1, vec2], [size(vec1), 2]) end do NumU = 0 - do i = 1, size(ModData) + do i = 1, size(Mods) vec1 = [(0, k=1, 0)] vec2 = [(0, k=1, 0)] - do j = 1, size(ModData(i)%Vars%u) - ModData(i)%Vars%u(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%u(j)%Field) - if (iand(ModData(i)%Vars%u(j)%Flags, VF_Solve) > 0) then - ModData(i)%Vars%u(j)%iGblSol = [(NumU + k, k=1, ModData(i)%Vars%u(j)%Size)] - vec1 = [vec1, ModData(i)%Vars%u(j)%iLoc] - vec2 = [vec2, ModData(i)%Vars%u(j)%iGblSol] - NumU = NumU + ModData(i)%Vars%u(j)%Size + do j = 1, size(Mods(i)%Vars%u) + Mods(i)%Vars%u(j)%Cat = VarCategory(Mods(i)%ID, Mods(i)%Vars%u(j)%Field) + if (iand(Mods(i)%Vars%u(j)%Flags, VF_Solve) > 0) then + Mods(i)%Vars%u(j)%iGblSol = [(NumU + k, k=1, Mods(i)%Vars%u(j)%Size)] + vec1 = [vec1, Mods(i)%Vars%u(j)%iLoc] + vec2 = [vec2, Mods(i)%Vars%u(j)%iGblSol] + NumU = NumU + Mods(i)%Vars%u(j)%Size end if end do - ModData(i)%ius = reshape([vec1, vec2], [size(vec1), 2]) + Mods(i)%ius = reshape([vec1, vec2], [size(vec1), 2]) end do NumY = 0 - do i = 1, size(ModData) + do i = 1, size(Mods) vec1 = [(0, k=1, 0)] vec2 = [(0, k=1, 0)] - do j = 1, size(ModData(i)%Vars%y) - ModData(i)%Vars%y(j)%Cat = VarCategory(ModData(i)%ID, ModData(i)%Vars%y(j)%Field) - if (iand(ModData(i)%Vars%y(j)%Flags, VF_Solve) > 0) then - ModData(i)%Vars%y(j)%iGblSol = [(NumY + k, k=1, ModData(i)%Vars%y(j)%Size)] - vec1 = [vec1, ModData(i)%Vars%y(j)%iLoc] - vec2 = [vec2, ModData(i)%Vars%y(j)%iGblSol] - NumY = NumY + ModData(i)%Vars%y(j)%Size + do j = 1, size(Mods(i)%Vars%y) + Mods(i)%Vars%y(j)%Cat = VarCategory(Mods(i)%ID, Mods(i)%Vars%y(j)%Field) + if (iand(Mods(i)%Vars%y(j)%Flags, VF_Solve) > 0) then + Mods(i)%Vars%y(j)%iGblSol = [(NumY + k, k=1, Mods(i)%Vars%y(j)%Size)] + vec1 = [vec1, Mods(i)%Vars%y(j)%iLoc] + vec2 = [vec2, Mods(i)%Vars%y(j)%iGblSol] + NumY = NumY + Mods(i)%Vars%y(j)%Size end if end do - ModData(i)%iys = reshape([vec1, vec2], [size(vec1), 2]) + Mods(i)%iys = reshape([vec1, vec2], [size(vec1), 2]) end do !---------------------------------------------------------------------------- @@ -194,40 +194,40 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) n = 0 ! Loop through modules - do i = 1, size(ModData) + do i = 1, size(Mods) ! Allocate iq to store q index for each variable - call AllocAry(iq, size(ModData(i)%Vars%x), "iq", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(iq, size(Mods(i)%Vars%x), "iq", ErrStat2, ErrMsg2); if (Failed()) return iq = 0 ! Skip modules that aren't in tight coupling - if (all(ModData(i)%ID /= TC_Modules)) cycle + if (all(Mods(i)%ID /= TC_Modules)) cycle ! Loop through state variables - do j = 1, size(ModData(i)%Vars%x) + do j = 1, size(Mods(i)%Vars%x) ! Skip variables which already have a q index if (iq(j) /= 0) cycle ! Skip load variables (force and moment) - if (any(ModData(i)%Vars%x(j)%Field == LoadFields)) cycle + if (any(Mods(i)%Vars%x(j)%Field == LoadFields)) cycle ! Set q index for variable and update number iq(j) = NumQ + 1 - NumQ = NumQ + ModData(i)%Vars%x(j)%Size + NumQ = NumQ + Mods(i)%Vars%x(j)%Size ! Loop through remaining vars if the names match - do k = i + 1, size(ModData(i)%Vars%x) + do k = i + 1, size(Mods(i)%Vars%x) ! If names are different then they don't match, skip - if (ModData(i)%Vars%x(j)%Name /= ModData(i)%Vars%x(k)%Name) cycle + if (Mods(i)%Vars%x(j)%Name /= Mods(i)%Vars%x(k)%Name) cycle ! If field is not the same or a derivative of current field, skip - select case (ModData(i)%Vars%x(j)%Field) + select case (Mods(i)%Vars%x(j)%Field) case (VF_TransDisp, VF_TransVel, VF_TransAcc) - if (all(ModData(i)%Vars%x(k)%Field /= TransFields)) cycle + if (all(Mods(i)%Vars%x(k)%Field /= TransFields)) cycle case (VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc) - if (all(ModData(i)%Vars%x(k)%Field /= AngularFields)) cycle + if (all(Mods(i)%Vars%x(k)%Field /= AngularFields)) cycle case (VF_Force, VF_Moment) cycle end select @@ -240,10 +240,10 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) ! Loop through state variables and build mapping array between x and q ! ixqd is 3xN where each row is [global x array index, q matrix row, q matrix col] - do j = 1, size(ModData(i)%Vars%x) - do k = 1, ModData(i)%Vars%x(j)%Size + do j = 1, size(Mods(i)%Vars%x) + do k = 1, Mods(i)%Vars%x(j)%Size n = n + 1 - p%ixqd(:, n) = [ModData(i)%Vars%x(j)%iGblSol(k), iq(j) + k - 1, ModData(i)%Vars%x(j)%DerivOrder + 1] + p%ixqd(:, n) = [Mods(i)%Vars%x(j)%iGblSol(k), iq(j) + k - 1, Mods(i)%Vars%x(j)%DerivOrder + 1] end do end do @@ -269,14 +269,14 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) ! Calculate index mapping arrays for X1Tight and X2Tight call AllocAry(p%iX1Tight, 0, "p%iX1Tight", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(p%iX2Tight, 0, "p%iX2Tight", ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(ModData) - do j = 1, size(ModData(i)%Vars%x) - if (ModData(i)%Vars%x(j)%Cat == VC_Tight) then - select case (ModData(i)%Vars%x(j)%DerivOrder) + do i = 1, size(Mods) + do j = 1, size(Mods(i)%Vars%x) + if (Mods(i)%Vars%x(j)%Cat == VC_Tight) then + select case (Mods(i)%Vars%x(j)%DerivOrder) case (0) - p%iX1Tight = [p%iX1Tight, ModData(i)%Vars%x(j)%iGblSol] + p%iX1Tight = [p%iX1Tight, Mods(i)%Vars%x(j)%iGblSol] case (1) - p%iX2Tight = [p%iX2Tight, ModData(i)%Vars%x(j)%iGblSol] + p%iX2Tight = [p%iX2Tight, Mods(i)%Vars%x(j)%iGblSol] end select end if end do @@ -288,9 +288,9 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) call AllocAry(p%iUOpt1, 0, "p%iUOpt1", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(isLoadTight, 0, "isLoadTight", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(isLoadOption1, 0, "isLoadOption1", ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(ModData) - do j = 1, size(ModData(i)%Vars%u) - associate (Var => ModData(i)%Vars%u(j)) + do i = 1, size(Mods) + do j = 1, size(Mods(i)%Vars%u) + associate (Var => Mods(i)%Vars%u(j)) if (iand(Var%Flags, VF_Solve) == 0) cycle isLoad = any(LoadFields == Var%Field) select case (Var%Cat) @@ -311,14 +311,14 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) ! Calculate index mapping arrays for y^Tight and y^Option1 call AllocAry(p%iyTight, 0, "p%iyTight", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(p%iyOpt1, 0, "p%iyOpt1", ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(ModData) - do j = 1, size(ModData(i)%Vars%y) - if (iand(ModData(i)%Vars%y(j)%Flags, VF_Solve) == 0) cycle - select case (ModData(i)%Vars%y(j)%Cat) + do i = 1, size(Mods) + do j = 1, size(Mods(i)%Vars%y) + if (iand(Mods(i)%Vars%y(j)%Flags, VF_Solve) == 0) cycle + select case (Mods(i)%Vars%y(j)%Cat) case (VC_Tight) - p%iyTight = [p%iyTight, ModData(i)%Vars%y(j)%iGblSol] + p%iyTight = [p%iyTight, Mods(i)%Vars%y(j)%iGblSol] case (VC_Option1) - p%iyOpt1 = [p%iyOpt1, ModData(i)%Vars%y(j)%iGblSol] + p%iyOpt1 = [p%iyOpt1, Mods(i)%Vars%y(j)%iGblSol] end select end do end do @@ -391,56 +391,56 @@ subroutine Solver_Init(p, m, ModData, ErrStat, ErrMsg) ! Debug !---------------------------------------------------------------------------- - ! call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return - ! call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return + call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return + call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return ! call GetNewUnit(munit, ErrStat2, ErrMsg2); if (Failed()) return - ! write (m%DebugUnit, *) "NumX = ", NumX - ! write (m%DebugUnit, *) "NumU = ", NumU - ! write (m%DebugUnit, *) "NumY = ", NumY - ! write (m%DebugUnit, *) "NumY = ", NumY - ! write (m%DebugUnit, *) "NumJac = ", NumY - ! write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 - ! write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT - ! write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 - ! write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL - ! write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight - ! write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 - ! write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight - ! write (m%DebugUnit, '(A,*(I4))') " p%iyOpt1 = ", p%iyOpt1 - ! write (m%DebugUnit, *) "shape(m%dYdx) = ", shape(m%dYdx) - ! write (m%DebugUnit, *) "shape(m%dYdu) = ", shape(m%dYdu) - ! write (m%DebugUnit, *) "shape(m%dXdx) = ", shape(m%dXdx) - ! write (m%DebugUnit, *) "shape(m%dXdu) = ", shape(m%dXdu) - ! write (m%DebugUnit, *) "shape(m%dUdu) = ", shape(m%dUdu) - ! write (m%DebugUnit, *) "shape(m%dUdy) = ", shape(m%dUdy) - - ! do i = 1, size(ModData) - ! write (m%DebugUnit, *) "Module = ", ModData(i)%Abbr - ! write (m%DebugUnit, *) "ModuleID = ", ModData(i)%ID - ! do j = 1, size(ModData(i)%Vars%x) - ! if (.not. allocated(ModData(i)%Vars%x(j)%iGblSol)) cycle - ! write (m%DebugUnit, *) "Var = "//trim(ModData(i)%Abbr)//trim(Num2LStr(ModData(i)%Instance))//" X "//trim(ModData(i)%Vars%x(j)%Name)// & - ! " ("//trim(MV_FieldString(ModData(i)%Vars%x(j)%Field))//")" - ! write (m%DebugUnit, '(A,*(I4))') " X iLoc = ", ModData(i)%Vars%x(j)%iLoc - ! write (m%DebugUnit, '(A,*(I4))') " X iGblSol = ", ModData(i)%Vars%x(j)%iGblSol - ! end do - ! do j = 1, size(ModData(i)%Vars%u) - ! if (.not. allocated(ModData(i)%Vars%u(j)%iGblSol)) cycle - ! write (m%DebugUnit, *) "Var = "//trim(ModData(i)%Abbr)//trim(Num2LStr(ModData(i)%Instance))//" U "//trim(ModData(i)%Vars%u(j)%Name)// & - ! " ("//trim(MV_FieldString(ModData(i)%Vars%u(j)%Field))//")" - ! write (m%DebugUnit, '(A,*(I4))') " U iLoc = ", ModData(i)%Vars%u(j)%iLoc - ! write (m%DebugUnit, '(A,*(I4))') " U iGblSol = ", ModData(i)%Vars%u(j)%iGblSol - ! end do - ! do j = 1, size(ModData(i)%Vars%y) - ! if (.not. allocated(ModData(i)%Vars%y(j)%iGblSol)) cycle - ! write (m%DebugUnit, *) "Var = "//trim(ModData(i)%Abbr)//trim(Num2LStr(ModData(i)%Instance))//" Y "//trim(ModData(i)%Vars%y(j)%Name)// & - ! " ("//trim(MV_FieldString(ModData(i)%Vars%y(j)%Field))//")" - ! write (m%DebugUnit, '(A,*(I4))') " Y iLoc = ", ModData(i)%Vars%y(j)%iLoc - ! write (m%DebugUnit, '(A,*(I4))') " Y iGblSol = ", ModData(i)%Vars%y(j)%iGblSol - ! end do - ! end do + write (m%DebugUnit, *) "NumX = ", NumX + write (m%DebugUnit, *) "NumU = ", NumU + write (m%DebugUnit, *) "NumY = ", NumY + write (m%DebugUnit, *) "NumY = ", NumY + write (m%DebugUnit, *) "NumJac = ", NumY + write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 + write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT + write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 + write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL + write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight + write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 + write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight + write (m%DebugUnit, '(A,*(I4))') " p%iyOpt1 = ", p%iyOpt1 + write (m%DebugUnit, *) "shape(m%dYdx) = ", shape(m%dYdx) + write (m%DebugUnit, *) "shape(m%dYdu) = ", shape(m%dYdu) + write (m%DebugUnit, *) "shape(m%dXdx) = ", shape(m%dXdx) + write (m%DebugUnit, *) "shape(m%dXdu) = ", shape(m%dXdu) + write (m%DebugUnit, *) "shape(m%dUdu) = ", shape(m%dUdu) + write (m%DebugUnit, *) "shape(m%dUdy) = ", shape(m%dUdy) + + do i = 1, size(Mods) + write (m%DebugUnit, *) "Module = ", Mods(i)%Abbr + write (m%DebugUnit, *) "ModuleID = ", Mods(i)%ID + do j = 1, size(Mods(i)%Vars%x) + if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle + write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & + " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" + write (m%DebugUnit, '(A,*(I4))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc + write (m%DebugUnit, '(A,*(I4))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol + end do + do j = 1, size(Mods(i)%Vars%u) + if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle + write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & + " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" + write (m%DebugUnit, '(A,*(I4))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc + write (m%DebugUnit, '(A,*(I4))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol + end do + do j = 1, size(Mods(i)%Vars%y) + if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle + write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & + " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" + write (m%DebugUnit, '(A,*(I4))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc + write (m%DebugUnit, '(A,*(I4))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol + end do + end do contains function Failed() @@ -471,15 +471,13 @@ pure function VarCategory(ModID, VarField) result(VarCat) end subroutine -subroutine InitMeshMappings(Mappings, ModData, iModOpt1, iModOpt2, ErrStat, ErrMsg) - type(TC_MeshMapType), allocatable, intent(inout) :: Mappings(:) - integer(IntKi), intent(in) :: iModOpt1(:) - integer(IntKi), intent(in) :: iModOpt2(:) - type(ModDataType), intent(inout) :: ModData(:) !< Solution variables from modules +subroutine Solver_DefineMappings(Mappings, Mods, ErrStat, ErrMsg) + type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) + type(ModDataType), intent(inout) :: Mods(:) !< Solution variables from modules integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'InitMeshMappings' + character(*), parameter :: RoutineName = 'Solver_DefineMappings' integer(IntKi) :: ErrStat2 ! local error status character(ErrMsgLen) :: ErrMsg2 ! local error message integer(IntKi) :: iMap, iModOut, iModIn, i, j @@ -500,15 +498,15 @@ subroutine InitMeshMappings(Mappings, ModData, iModOpt1, iModOpt2, ErrStat, ErrM return end if - do iMap = 1, size(ModData) - if (ModData(iMap)%ID == Module_BD) then - iModOut = ModData(iMap)%Ins + do iMap = 1, size(Mods) + if (Mods(iMap)%ID == Module_BD) then + iModOut = Mods(iMap)%Ins call AddMotionMapping(Key='ED BladeRoot -> BD RootMotion', & - SrcModID=Module_ED, SrcModInst=1, SrcMeshName='Blade root '//trim(Num2LStr(iModOut)), & - DstModID=Module_BD, DstModInst=iModOut, DstMeshName='RootMotion') + SrcModID=Module_ED, SrcIns=1, SrcMeshName='Blade root '//trim(Num2LStr(iModOut)), & + DstModID=Module_BD, DstIns=iModOut, DstMeshName='RootMotion') call AddLoadMapping(Key='BD ReactionForce -> ED HubLoad', & - SrcModID=Module_BD, SrcModInst=iModOut, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & - DstModID=Module_ED, DstModInst=1, DstMeshName='Hub', DstDispMeshName='Hub') + SrcModID=Module_BD, SrcIns=iModOut, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & + DstModID=Module_ED, DstIns=1, DstMeshName='Hub', DstDispMeshName='Hub') end if end do @@ -526,52 +524,33 @@ subroutine InitMeshMappings(Mappings, ModData, iModOpt1, iModOpt2, ErrStat, ErrM ! Loop through mappings do iMap = 1, size(Mappings) - ! Loop through output modules - do iModOut = 1, size(ModData) - - ! If mapping output module ID or instance doesn't match, cycle - if ((Mappings(iMap)%SrcModID /= ModData(iModOut)%ID) .or. (Mappings(iMap)%SrcModInst /= ModData(iModOut)%Ins)) cycle - - ! Loop through input modules - do iModIn = 1, size(ModData) - - ! If mapping input module ID or instance doesn't match, cycle - if ((Mappings(iMap)%DstModID /= ModData(iModIn)%ID) .or. (Mappings(iMap)%DstModInst /= ModData(iModIn)%Ins)) cycle - - ! Module input/ouput IDs and instances found, populate mapping - Mappings(iMap)%SrcModIdx = iModOut - Mappings(iMap)%DstModIdx = iModIn - isActive(iMap) = .true. + ! Loop modules, if module ID matches source module ID + ! and module instance matches source module instance, exit loop + do iModOut = 1, size(Mods) + if ((Mappings(iMap)%SrcModID == Mods(iModOut)%ID) .and. & + (Mappings(iMap)%SrcIns == Mods(iModOut)%Ins)) exit + end do - ! If the input module is in Option 1 and the output module is - ! before it, add mapping index to array of Option 1 maps for input - i = FindIndex(iModOpt1, iModIn) - if (i > 0) then - if (FindIndex(iModOpt1(:i), iModOut) > 0) then - ModData(iModIn)%iMapsOpt1 = [ModData(iModIn)%iMapsOpt1, iMap] - end if - end if + ! Loop through modules, if module ID matches destination module ID + ! and module instance matches destinatino module instance, exit loop + do iModIn = 1, size(Mods) + if ((Mappings(iMap)%DstModID == Mods(iModIn)%ID) .and. & + (Mappings(iMap)%DstIns == Mods(iModIn)%Ins)) exit + end do - ! If the input module is in Option 2 and the output module is - ! before it, add mapping index to array of Option 2 maps for input - i = FindIndex(iModOpt2, iModIn) - if (i > 0) then - if (FindIndex(iModOpt2(:i), iModOut) > 0) then - ModData(iModIn)%iMapsOpt2 = [ModData(iModIn)%iMapsOpt2, iMap] - end if - end if + ! If input or output module not found, mapping is not active, cycle + if (iModOut > size(Mods) .or. iModIn > size(Mods)) cycle - ! Add mapping to all index - ModData(iModIn)%iMapsAll = [ModData(iModIn)%iMapsAll, iMap] - end do - end do + ! Mark mapping as active + isActive(iMap) = .true. - ! If mapping was not marked as active, cycle - if (.not. isActive(iMap)) cycle + ! Module input/ouput IDs and instances found, populate mapping + Mappings(iMap)%SrcModIdx = iModOut + Mappings(iMap)%DstModIdx = iModIn associate (map => Mappings(iMap), & - SrcMod => ModData(Mappings(iMap)%SrcModIdx), & - DstMod => ModData(Mappings(iMap)%DstModIdx)) + SrcMod => Mods(Mappings(iMap)%SrcModIdx), & + DstMod => Mods(Mappings(iMap)%DstModIdx)) ! If load mapping if (map%IsLoad) then @@ -622,42 +601,29 @@ subroutine InitMeshMappings(Mappings, ModData, iModOpt1, iModOpt2, ErrStat, ErrM Mappings = pack(Mappings, mask=isActive) contains - subroutine AddLoadMapping(Key, SrcModID, SrcModInst, SrcMeshName, SrcDispMeshName, & - DstModID, DstModInst, DstMeshName, DstDispMeshName) + subroutine AddLoadMapping(Key, SrcModID, SrcIns, SrcMeshName, SrcDispMeshName, & + DstModID, DstIns, DstMeshName, DstDispMeshName) character(*), intent(in) :: Key integer(IntKi), intent(in) :: SrcModID, DstModID - integer(IntKi), intent(in) :: SrcModInst, DstModInst + integer(IntKi), intent(in) :: SrcIns, DstIns character(*), intent(in) :: SrcMeshName, DstMeshName character(*), intent(in) :: SrcDispMeshName, DstDispMeshName if (.not. allocated(Mappings)) allocate (Mappings(0)) - Mappings = [Mappings, TC_MeshMapType(Key=Key, isLoad=.true., & - SrcModID=SrcModID, SrcModInst=SrcModInst, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & - DstModID=DstModID, DstModInst=DstModInst, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] + Mappings = [Mappings, TC_MappingType(Key=Key, isLoad=.true., & + SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & + DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] end subroutine - subroutine AddMotionMapping(Key, SrcModID, SrcModInst, SrcMeshName, & - DstModID, DstModInst, DstMeshName) + subroutine AddMotionMapping(Key, SrcModID, SrcIns, SrcMeshName, & + DstModID, DstIns, DstMeshName) character(*), intent(in) :: Key integer(IntKi), intent(in) :: SrcModID, DstModID - integer(IntKi), intent(in) :: SrcModInst, DstModInst + integer(IntKi), intent(in) :: SrcIns, DstIns character(*), intent(in) :: SrcMeshName, DstMeshName if (.not. allocated(Mappings)) allocate (Mappings(0)) - Mappings = [Mappings, TC_MeshMapType(Key=Key, isLoad=.false., & - SrcModID=SrcModID, SrcModInst=SrcModInst, SrcMeshName=SrcMeshName, & - DstModID=DstModID, DstModInst=DstModInst, DstMeshName=DstMeshName)] + Mappings = [Mappings, TC_MappingType(Key=Key, isLoad=.false., & + SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, & + DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName)] end subroutine - function FindIndex(ModOrder, Ind) result(OutInd) - integer(IntKi), intent(in) :: ModOrder(:) - integer(IntKi), intent(in) :: Ind - integer(IntKi) :: OutInd - integer(IntKi) :: i - OutInd = 0 - do i = 1, size(ModOrder) - if (ModOrder(i) == Ind) then - OutInd = i - exit - end if - end do - end function end subroutine subroutine Solver_TransferXtoQ(ixqd, x, q) @@ -756,6 +722,9 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) call AllocAry(accel, size(m%qn, dim=2), "accel", ErrStat2, ErrMsg2); if (Failed()) return accel = m%qn(:, COL_A) + ! Reset mappings updated flags + m%Mappings%Updated = .false. + ! Loop until initial accelerations are converged, or max iterations are reached. ! TODO: may need a separate variable for max initial acceleration convergence iterations converged = .false. @@ -764,10 +733,12 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Transfer inputs and calculate outputs for all modules (use current state) do i = 1, size(p%iModAll) - call FAST_InputSolve(ModData(p%iModAll(i)), m%Mappings, 1, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_UpdateInputs(ModData(p%iModAll(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_CalcOutput(ModData(p%iModAll(i)), t_initial, STATE_CURR, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_MapOutputs(ModData(p%iModAll(i)), m%Mappings, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do ! Calculate continuous state derivatives for tight coupling modules (use current state) @@ -787,7 +758,7 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) diff = TwoNorm(accel - m%qn(:, COL_A)) ! If difference is less than converence tolerance, set flag and exit loop - if (diff < p%ConvTol) converged = .true. + if ((k > 1) .and. (diff < p%ConvTol)) converged = .true. ! Update acceleration in q matrix m%qn(:, COL_A) = accel @@ -872,7 +843,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 - ! write (m%DebugUnit, *) "step = ", n_t_global_next + write (m%DebugUnit, *) "step = ", n_t_global_next !---------------------------------------------------------------------------- ! Extrapolate/interpolate inputs for all modules @@ -922,29 +893,31 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM iterCorr = 0 do while (iterCorr <= p%NumCrctn) - ! write (m%DebugUnit, *) "iterCorr = ", iterCorr + write (m%DebugUnit, *) "iterCorr = ", iterCorr ! Copy state for correction step m%qn = m%q m%xn = m%x - ! Unpack the updated states into the modules - call UnpackModuleStates(Mods, p%iModTC, STATE_PRED, Turbine, m%xn) + ! Reset mappings updated flags + m%Mappings%Updated = .false. ! Loop through Option 2 modules do i = 1, size(p%iModOpt2) - call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, & + call FAST_UpdateInputs(Mods(p%iModOpt2(i)), m%Mappings, 1, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, & + Turbine, ErrStat2, ErrMsg2, m%xn); if (Failed()) return call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_MapOutputs(Mods(p%iModOpt2(i)), m%Mappings, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do ! Get inputs and update states for Option 1 modules not in Option 2 do i = 1, size(p%iModOpt1US) - call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_UpdateInputs(Mods(p%iModOpt1US(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -959,7 +932,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Loop through convergence iterations do iterConv = 0, p%MaxConvIter - ! write (m%DebugUnit, *) "iterConv = ", iterConv + write (m%DebugUnit, *) "iterConv = ", iterConv ! Decrement number of iterations before updating the Jacobian m%IterUntilUJac = m%IterUntilUJac - 1 @@ -990,6 +963,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0)) then call Solver_BuildJacobian(p, m, Mods, t_global_next, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return + write (m%DebugUnit, *) "BuildJacobian = 1" end if !---------------------------------------------------------------------- @@ -1007,8 +981,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer Option 1 outputs to temporary inputs and collect into u_tmp do i = 1, size(p%iModOpt1) - call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, 2, & + call FAST_MapOutputs(Mods(p%iModOpt1(i)), m%Mappings, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_UpdateInputs(Mods(p%iModOpt1(i)), m%Mappings, 2, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do call PackModuleInputs(Mods, p%iModOpt1, Turbine, u_tmp=m%u_tmp) @@ -1018,12 +994,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM m%XB(p%iJT, 1) = m%UDiff(p%iUTight) m%XB(p%iJ1, 1) = m%UDiff(p%iUOpt1) - ! write (m%DebugUnit, '(A,*(ES16.7))') "m%y = ", m%y - ! write (m%DebugUnit, '(A,*(ES16.7))') "m%un-1 = ", m%un - ! write (m%DebugUnit, '(A,*(ES16.7))') "m%u_tmp = ", m%u_tmp - ! write (m%DebugUnit, '(A,*(ES16.7))') "m%UDiff = ", m%UDiff - ! write (m%DebugUnit, '(A,*(ES16.7))') "m%xn-1 = ", m%xn - ! Apply conditioning factor to loads in RHS m%XB(p%iJL, 1) = m%XB(p%iJL, 1)/p%Scale_UJac @@ -1042,7 +1012,14 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- delta_norm = TwoNorm(m%XB(:, 1)) - ! write (m%DebugUnit, *) "delta_norm = ", delta_norm + + write (m%DebugUnit, '(A,*(ES16.7))') " m%y = ", m%y + write (m%DebugUnit, '(A,*(ES16.7))') " m%un-1 = ", m%un + write (m%DebugUnit, '(A,*(ES16.7))') " m%u_tmp = ", m%u_tmp + write (m%DebugUnit, '(A,*(ES16.7))') " m%UDiff = ", m%UDiff + write (m%DebugUnit, '(A,*(ES16.7))') " m%xn-1 = ", m%xn + write (m%DebugUnit, *) "delta_norm = ", delta_norm + if (delta_norm < p%ConvTol) exit !---------------------------------------------------------------------- @@ -1108,7 +1085,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------------- ! Copy the final predicted states from step t_global_next to actual states for that step - call FAST_SaveStates(Mods(p%iModAll), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_SaveStates(Mods, Turbine, ErrStat2, ErrMsg2); if (Failed()) return ! Save new state m%x = m%xn From 152f4ad8fbfc60da9b717fda848283d357fe5372 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 29 Jun 2023 14:18:49 +0000 Subject: [PATCH 13/61] Resolve BeamDyn initial strain for rotated blade In the BeamDyn driver, and likely in the glue-code, if the blade was initially rotated then an initial strain was introduced which produced forces when no loads or gravity had been applied. The cause was traced to the calculation of R0 (initial rotation) at the quadrature points which was interpolated via the shape functions from the element nodal rotations. The shape function interpolation is not exact and introduced strains on the order of 1e-7, but with the large stiffness of the blade, forces of 6200 N could be produced at the root for the IEA 15MW blade. This was resolved by directly calculating the quadrature point initial rotations in uu0(4:6) via interpolated tangent and twist, which are well behaved. This was only a problem for non-straight blades such as the IEA 15MW. This commit also fixes a bug where the parameter UsePitchAct wasn't initialized from the input file until after it was used in SetOutParam. The initialization has been moved to SetParameters. --- modules/beamdyn/src/BeamDyn.f90 | 213 ++++++++---------- modules/beamdyn/src/BeamDyn_Subs.f90 | 2 +- modules/beamdyn/src/Registry_BeamDyn.txt | 4 +- .../tests/test_BD_QuadraturePointData.F90 | 52 ++--- modules/beamdyn/tests/test_tools.F90 | 2 +- 5 files changed, 123 insertions(+), 150 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index b99902253a..62340fd3cc 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -177,7 +177,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I return end if - ! Set the initial displacements: p%uu0, p%rrN0, p%E10 + ! Set the initial displacements: p%uu0, p%E10 CALL BD_QuadraturePointDataAt0(p) if (ErrStat >= AbortErrLev) then call cleanup() @@ -197,27 +197,9 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ! Actuator - p%UsePitchAct = InputFileData%UsePitchAct if (p%UsePitchAct) then - p%pitchK = InputFileData%pitchK - p%pitchC = InputFileData%pitchC - p%pitchJ = InputFileData%pitchJ - - ! calculate (I-hA)^-1 - - p%torqM(1,1) = p%pitchJ + p%pitchC*p%dt - p%torqM(2,1) = -p%pitchK * p%dt - p%torqM(1,2) = p%pitchJ * p%dt - p%torqM(2,2) = p%pitchJ - denom = p%pitchJ + p%pitchC*p%dt + p%pitchK*p%dt**2 - if (EqualRealNos(denom,0.0_BDKi)) then - call SetErrStat(ErrID_Fatal,"Cannot invert matrix for pitch actuator: J+c*dt+k*dt^2 is zero.",ErrStat,ErrMsg,RoutineName) - else - p%torqM(:,:) = p%torqM / denom - end if - ! Calculate the pitch angle TmpDCM(:,:) = MATMUL(u%RootMotion%Orientation(:,:,1),TRANSPOSE(u%HubMotion%Orientation(:,:,1))) temp_CRV(:) = EulerExtract(TmpDCM) @@ -872,8 +854,12 @@ subroutine InitializeNodalLocations(member_total,kp_member,kp_coordinate,p,GLL_n tangent = tangent / TwoNorm(tangent) + ! Calculate the node initial rotation CALL BD_ComputeIniNodalCrv(tangent, twist, temp_CRV, ErrStat, ErrMsg) + + ! Store rotation in node initial position vector and save node twist p%uuN0(4:6,i,elem) = temp_CRV + p%twN0(i,elem) = twist enddo @@ -1010,11 +996,11 @@ SUBROUTINE BD_InitShpDerJaco( GLL_Nodes, p ) CALL BD_diffmtc(p%nodes_per_elem,GLL_nodes,p%QPtN,p%nqp,p%Shp,p%ShpDer) + ! Calculate the Jacobian relating element axial length to real coordinates DO nelem = 1,p%elem_total DO idx_qp = 1, p%nqp - Gup0(:) = 0.0_BDKi - DO i=1,p%nodes_per_elem - Gup0(:) = Gup0(:) + p%ShpDer(i,idx_qp)*p%uuN0(1:3,i,nelem) + DO i=1,3 + Gup0(i) = dot_product(p%ShpDer(:,idx_qp), p%uuN0(i,:,nelem)) ENDDO p%Jacobian(idx_qp,nelem) = TwoNorm(Gup0) ENDDO @@ -1122,6 +1108,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'SetParameters' + real(DbKi) :: denom @@ -1202,7 +1189,25 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%dof_elem = p%dof_node * p%nodes_per_elem p%rot_elem = (p%dof_node/2) * p%nodes_per_elem + ! Actuator + p%UsePitchAct = InputFileData%UsePitchAct + if (p%UsePitchAct) then + p%pitchK = InputFileData%pitchK + p%pitchC = InputFileData%pitchC + p%pitchJ = InputFileData%pitchJ + ! calculate (I-hA)^-1 + p%torqM(1,1) = p%pitchJ + p%pitchC*p%dt + p%torqM(2,1) = -p%pitchK * p%dt + p%torqM(1,2) = p%pitchJ * p%dt + p%torqM(2,2) = p%pitchJ + denom = p%pitchJ + p%pitchC*p%dt + p%pitchK*p%dt**2 + if (EqualRealNos(denom,0.0_BDKi)) then + call SetErrStat(ErrID_Fatal,"Cannot invert matrix for pitch actuator: J+c*dt+k*dt^2 is zero.",ErrStat,ErrMsg,RoutineName) + else + p%torqM(:,:) = p%torqM / denom + end if + end if !................................ ! allocate some parameter arrays @@ -1224,7 +1229,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) CALL AllocAry(p%uuN0, p%dof_node,p%nodes_per_elem, p%elem_total,'uuN0 (initial position) array',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry(p%rrN0, (p%dof_node/2),p%nodes_per_elem, p%elem_total,'p%rrN0',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(p%twN0, p%nodes_per_elem, p%elem_total,'twN0 (initial twist) array',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%uu0, p%dof_node, p%nqp, p%elem_total,'p%uu0', ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%E10, (p%dof_node/2),p%nqp, p%elem_total,'p%E10', ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2465,72 +2470,57 @@ SUBROUTINE BD_QuadraturePointDataAt0( p ) TYPE(BD_ParameterType), INTENT(INOUT) :: p !< Parameters - REAL(BDKi) :: rot0_temp(3) - REAL(BDKi) :: rotu_temp(3) - REAL(BDKi) :: rot_temp(3) - REAL(BDKi) :: R0_temp(3,3) - + CHARACTER(*), PARAMETER :: RoutineName = 'BD_QuadraturePointDataAt0' + INTEGER(IntKi) :: ErrStat2 ! The error status code + CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred INTEGER(IntKi) :: nelem ! number of current element INTEGER(IntKi) :: idx_qp ! index of current quadrature point - INTEGER(IntKi) :: idx_node ! index of current GLL node + INTEGER(IntKi) :: i + REAL(BDKi) :: twist, tan_vect(3), R0(3), u0(3) - CHARACTER(*), PARAMETER :: RoutineName = 'BD_QuadraturePointDataAt0' - - - ! Initialize to zero for the summation - p%uu0(:,:,:) = 0.0_BDKi - p%rrN0(:,:,:) = 0.0_BDKi - p%E10(:,:,:) = 0.0_BDKi - - - ! calculate rrN0 (Initial relative rotation array) + ! Loop through elements DO nelem = 1,p%elem_total - p%rrN0(1:3,1,nelem) = (/ 0.0_BDKi, 0.0_BDKi, 0.0_BDKi /) ! first node has no rotation relative to itself. - DO idx_node=2,p%nodes_per_elem - ! Find resulting rotation parameters R(Nr) = Ri^T(Nu(1)) R(Nu(:)) - ! where R(Nu(1))^T is the transpose rotation parameters for the root node - CALL BD_CrvCompose(p%rrN0(1:3,idx_node,nelem),p%uuN0(4:6,1,nelem),p%uuN0(4:6,idx_node,nelem),FLAG_R1TR2) ! rrN0 = node composed with root - ENDDO - ENDDO + ! Loop through quadrature points + do idx_qp = 1, p%nqp - DO nelem = 1,p%elem_total - DO idx_qp = 1,p%nqp - !> ### Calculate the the initial displacement fields in an element - !! Initial displacement field \n - !! \f$ \underline{u_0}\left( \xi \right) = - !! \sum_{k=1}^{p+1} h^k\left( \xi \right) \underline{\hat{u}_0}^k - !! \f$ \n - !! and curvature \n - !! \f$ \underline{c_0}\left( \xi \right) = - !! \sum_{k=1}^{p+1} h^k\left( \xi \right) \underline{\hat{c}_0}^k - !! \f$ + ! Loop through displacement DOFs + do i = 1,3 - ! Note that p%uu0 was set to zero prior to this routine call, so the following is the summation. + ! Calculate the quadrature point initial positions by using the + ! shape functions to interpolate from the node initial positions + ! Initial displacement field \n + ! \f$ \underline{u_0}\left( \xi \right) = + ! \sum_{k=1}^{p+1} h^k\left( \xi \right) \underline{\hat{u}_0}^k + ! \f$ + u0(i) = dot_product(p%Shp(:,idx_qp), p%uuN0(i,:,nelem)) - DO idx_node=1,p%nodes_per_elem - p%uu0(1:3,idx_qp,nelem) = p%uu0(1:3,idx_qp,nelem) + p%Shp(idx_node,idx_qp)*p%uuN0(1:3,idx_node,nelem) - p%uu0(4:6,idx_qp,nelem) = p%uu0(4:6,idx_qp,nelem) + p%Shp(idx_node,idx_qp)*p%rrN0(1:3,idx_node,nelem) - ENDDO + ! Calculate \f$ x_0^\prime \f$, the derivative with respect to \f$ \hat{x} \f$-direction + ! (tangent to curve through this GLL point) + ! This uses the shape function derivative to calculate the tangent at the quadrature points + ! with respect to the element axis from the node positions. + ! Note: this is a unit vector after scaling by the Jacobian + tan_vect(i) = dot_product(p%ShpDer(:,idx_qp), p%uuN0(i,:,nelem)) / p%Jacobian(idx_qp,nelem) + end do - !> Add the blade root rotation parameters. That is, - !! compose the rotation parameters calculated with the shape functions with the rotation parameters - !! for the blade root. - rot0_temp(:) = p%uuN0(4:6,1,nelem) ! Rotation at root - rotu_temp(:) = p%uu0( 4:6,idx_qp,nelem) ! Rotation at current GLL point without root rotation + ! Interpolate the twist to QP from the shape function and node values + twist = dot_product(p%Shp(:,idx_qp), p%twN0(:,nelem)) - CALL BD_CrvCompose(rot_temp,rot0_temp,rotu_temp,FLAG_R1R2) ! rot_temp = rot0_temp composed with rotu_temp - p%uu0(4:6,idx_qp,nelem) = rot_temp(:) ! Rotation parameters at current GLL point with the root orientation + ! Calculate quadrature point initial rotation, R0 + ! The nodal rotation function is used to avoid errors that occur when + ! when interpolating the QP rotations from the node rotations. + call BD_ComputeIniNodalCrv(tan_vect, twist, R0, ErrStat2, ErrMsg2) + ! Save initial position and rotation + p%uu0(1:3,idx_qp,nelem) = u0 + p%uu0(4:6,idx_qp,nelem) = R0 - !> Set the initial value of \f$ x_0^\prime \f$, the derivative with respect to \f$ \hat{x} \f$-direction - !! (tangent to curve through this GLL point). This is simply the - CALL BD_CrvMatrixR(p%uu0(4:6,idx_qp,nelem),R0_temp) ! returns R0_temp (the transpose of the DCM orientation matrix) - p%E10(:,idx_qp,nelem) = R0_temp(:,3) ! unit vector tangent to curve through this GLL point (derivative with respect to z in IEC coords). - ENDDO - ENDDO + ! Save initial tangent vector for calculating strain + p%E10(1:3,idx_qp,nelem) = tan_vect + end do + ENDDO END SUBROUTINE BD_QuadraturePointDataAt0 @@ -2579,48 +2569,43 @@ SUBROUTINE BD_DisplacementQP( nelem, p, x, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables - INTEGER(IntKi) :: idx_qp !< index to the current quadrature point - INTEGER(IntKi) :: elem_start !< Node point of first node in current element - INTEGER(IntKi) :: idx_node + INTEGER(IntKi) :: node_start !< Node point of first node in current element + INTEGER(IntKi) :: node_end !< Node point of last node in current element + INTEGER(IntKi) :: i, idx_qp CHARACTER(*), PARAMETER :: RoutineName = 'BD_DisplacementQP' + ! Node at start and end of element + node_start = p%node_elem_idx(nelem,1) + node_end = node_start + p%nodes_per_elem - 1 + + !> ### Calculate the the displacement fields in an element + !! Using equations (27) and (28) \n + !! \f$ \underline{u}\left( \xi \right) = + !! \sum_{i=1}^{p+1} h^i\left( \xi \right) \underline{\hat{u}}^i + !! \f$ \n + !! and \n + !! \f$ \underline{u}^\prime \left( \xi \right) = + !! \sum_{k=1}^{p+1} h^{k\prime} \left( \xi \right) \underline{\hat{u}}^i + !! \f$ + !! + !! | Variable | Value | + !! | :---------: | :------------------------------------------------------------------------- | + !! | \f$ \xi \f$ | Element natural coordinate \f$ \in [-1,1] \f$ | + !! | \f$ k \f$ | Node number of a \f$ p^\text{th} \f$ order Langrangian-interpolant | + !! | \f$ h^i \left( \xi \right ) \f$ | Component of the shape function matrix, \f$ \underline{\underline{N}} \f$ | + !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | + !! | \f$ \underline{\hat{u}}^i \f$ | \f$ k^\text{th} \f$ nodal value + + ! Loop through all quadrature points and displacement DOFs + ! dot_product appears to be more exact that matmul + forall (idx_qp = 1:p%nqp, i = 1:3) + m%qp%uuu(i,idx_qp,nelem) = dot_product(p%Shp(:,idx_qp), x%q(i,node_start:node_end)) + m%qp%uup(i,idx_qp,nelem) = dot_product(p%ShpDer(:,idx_qp), x%q(i,node_start:node_end)) / p%Jacobian(idx_qp,nelem) + end forall + + !> Calculate \f$ \underline{E}_1 = x_0^\prime + u^\prime \f$ (equation 23). Note E_1 is along the z direction. + m%qp%E1(1:3,:,nelem) = p%E10(1:3,:,nelem) + m%qp%uup(1:3,:,nelem) - DO idx_qp=1,p%nqp - ! Node point before start of this element - elem_start = p%node_elem_idx( nelem,1 ) - - - !> ### Calculate the the displacement fields in an element - !! Using equations (27) and (28) \n - !! \f$ \underline{u}\left( \xi \right) = - !! \sum_{i=1}^{p+1} h^i\left( \xi \right) \underline{\hat{u}}^i - !! \f$ \n - !! and \n - !! \f$ \underline{u}^\prime \left( \xi \right) = - !! \sum_{k=1}^{p+1} h^{k\prime} \left( \xi \right) \underline{\hat{u}}^i - !! \f$ - !! - !! | Variable | Value | - !! | :---------: | :------------------------------------------------------------------------- | - !! | \f$ \xi \f$ | Element natural coordinate \f$ \in [-1,1] \f$ | - !! | \f$ k \f$ | Node number of a \f$ p^\text{th} \f$ order Langrangian-interpolant | - !! | \f$ h^i \left( \xi \right ) \f$ | Component of the shape function matrix, \f$ \underline{\underline{N}} \f$ | - !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | - !! | \f$ \underline{\hat{u}}^i \f$ | \f$ k^\text{th} \f$ nodal value | - - ! Initialize values for summation - m%qp%uuu(:,idx_qp,nelem) = 0.0_BDKi ! displacement field \f$ \underline{u} \left( \xi \right) \f$ - m%qp%uup(:,idx_qp,nelem) = 0.0_BDKi ! displacement field \f$ \underline{u}^\prime \left( \xi \right) \f$ - - DO idx_node=1,p%nodes_per_elem - m%qp%uuu(1:3,idx_qp,nelem) = m%qp%uuu(1:3,idx_qp,nelem) + p%Shp(idx_node,idx_qp) *x%q(1:3,elem_start - 1 + idx_node) - m%qp%uup(1:3,idx_qp,nelem) = m%qp%uup(1:3,idx_qp,nelem) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem)*x%q(1:3,elem_start - 1 + idx_node) - ENDDO - - !> Calculate \f$ \underline{E}_1 = x_0^\prime + u^\prime \f$ (equation 23). Note E_1 is along the z direction. - m%qp%E1(1:3,idx_qp,nelem) = p%E10(1:3,idx_qp,nelem) + m%qp%uup(1:3,idx_qp,nelem) - - ENDDO END SUBROUTINE BD_DisplacementQP diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index e60ab59dab..b0006dafd1 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -1067,7 +1067,7 @@ SUBROUTINE BD_ComputeIniNodalCrv(e3, phi, cc, ErrStat, ErrMsg) Rr(:,2) = Cross_Product(e3,e1) Rr(:,1) = e1(:) - identity = 0. + identity = 0.0_BDKi do i = 1,3 identity(i,i) = 1.0_BDKi enddo diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 56444a25ec..b9fc09aa06 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -168,7 +168,8 @@ typedef ^ ParameterType DbKi coef {9} - - typedef ^ ParameterType DbKi rhoinf - - - "Numerical Damping Coefficient for GA2" #vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv #the following are BDKi = R8Ki -typedef ^ ParameterType R8Ki uuN0 {:}{:}{:} - - "Initial Postion Vector of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element)" - +typedef ^ ParameterType R8Ki uuN0 {:}{:}{:} - - "Initial Position Vector of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element)" - +typedef ^ ParameterType ^ twN0 {:}{:} - - "Initial Twist of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element)" - typedef ^ ParameterType ^ Stif0_QP {:}{:}{:} - - "Sectional Stiffness Properties at quadrature points (6x6xqp)" - typedef ^ ParameterType ^ Mass0_QP {:}{:}{:} - - "Sectional Mass Properties at quadrature points (6x6xqp)" - typedef ^ ParameterType ^ gravity {3} - - "Gravitational acceleration" m/s^2 @@ -189,7 +190,6 @@ typedef ^ ParameterType ^ Shp {:}{:} - - typedef ^ ParameterType ^ ShpDer {:}{:} - - "Derivative of shape function matrix (index 1 = FE nodes; index 2=quadrature points)" - typedef ^ ParameterType ^ Jacobian {:}{:} - - "Jacobian value at each quadrature point" - typedef ^ ParameterType ^ uu0 {:}{:}{:} - - "Initial Disp/Rot value at quadrature point (at T=0)" - -typedef ^ ParameterType ^ rrN0 {:}{:}{:} - - "Initial relative rotation array, relative to root (at T=0) (index 1=rot DOF; index 2=FE nodes; index 3=element)" - typedef ^ ParameterType ^ E10 {:}{:}{:} - - "Initial E10 at quadrature point" - #end of BDKi-type variables #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 b/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 index fcf4f75a4f..6101e47b92 100644 --- a/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 +++ b/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 @@ -27,7 +27,6 @@ module test_BD_QuadraturePointData real(BDKi), allocatable :: gll_nodes(:) real(BDKi), allocatable :: baseline_uu0(:,:,:) - real(BDKi), allocatable :: baseline_rrN0(:,:,:) real(BDKi), allocatable :: baseline_E10(:,:,:) real(BDKi), allocatable :: baseline_uuu(:,:,:) @@ -91,7 +90,6 @@ subroutine test_BD_QuadraturePointData_5node() call AllocAry(baseline_uu0 , p%dof_node, p%nqp, p%elem_total, 'baseline_uu0' , ErrStat, ErrMsg) call AllocAry(baseline_E10 , p%dof_node/2, p%nqp, p%elem_total, 'baseline_E10' , ErrStat, ErrMsg) - call AllocAry(baseline_rrN0 , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_rrN0' , ErrStat, ErrMsg) call AllocAry(baseline_uuu , p%dof_node, p%nqp, p%elem_total, 'baseline_uuu' , ErrStat, ErrMsg) call AllocAry(baseline_uup , p%dof_node/2, p%nqp, p%elem_total, 'baseline_uup' , ErrStat, ErrMsg) @@ -104,6 +102,10 @@ subroutine test_BD_QuadraturePointData_5node() call AllocAry(baseline_Stif , 6, 6, p%nqp, p%elem_total, 'baseline_Stif' , ErrStat, ErrMsg) + ! Allocate memory for GLL node positions in 1D parametric space + call AllocAry(gll_nodes, nodes_per_elem, "GLL points array", ErrStat, ErrMsg) + gll_nodes = (/ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. /) + ! assign baseline results ! uuN0 is of dimension (6 dof, nodes_per_elem, elem_total) @@ -123,27 +125,19 @@ subroutine test_BD_QuadraturePointData_5node() p%uuN0(1:3,5,1) = (/ -1., 1., 5. /) p%uuN0(4:6,5,1) = (/ -1.0730193445455083,-0.42803085368057275,1.292451050059679 /) - - ! the following is uuN0(4:6) with rotation of first node removed - baseline_rrN0(1:3,1,1) = (/ 0., 0., 0. /) - baseline_rrN0(1:3,2,1) = (/ -0.18695562365337798,-0.0032641497706398077,0.048935661676787534 /) - baseline_rrN0(1:3,3,1) = (/ -0.6080640291857297,-0.08595023366039768,0.4027112581652146 /) - baseline_rrN0(1:3,4,1) = (/ -1.1980591841054526,-0.3478409509012645,0.9658032687192992 /) - baseline_rrN0(1:3,5,1) = (/ -1.5856082606694464,-0.3853274394272689,1.3714709059387975 /) - ! We are just looking at one randomly selected point in the domain to test interpolation; can be expanded p%QptN(1) = 0.3 + ! Twist at nodes (nodes_per_elem, elem_total) + p%twN0(:,1) = 90.0*((gll_nodes+1)/2)**2 + ! Input baseline/reference quantities; uu0 and E10 are only for at quadrature points, so just 1 point here ! uu0 is reference line evaluated at quadrature point ! E10 is tangent evaluated at qudrature point baseline_uu0(1:3,1,1) = (/ 0.29298750000000007,-0.03250000000000007,3.2499999999999996 /) - baseline_uu0(4:6,1,1) = (/ -0.419497643454797,-0.1153574679103733,0.610107968645409 /) - baseline_E10(1:3,1,1) = (/ -0.22332806017852783,0.3449485111415417,0.9116661133321399 /) - - ! Allocate memory for GLL node positions in 1D parametric space - call AllocAry(gll_nodes, nodes_per_elem, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. /) + baseline_uu0(4:6,1,1) = (/ -0.42032456079463276,-0.10798264336200536,0.61929246125947701 /) + baseline_E10(1:3,1,1) = (/ -0.21838554154630824,0.34664371674017153,0.91222030721097547 /) + ! Build the shape functions and derivative of shape functions evaluated at QP points; this is tested elsewhere call BD_InitShpDerJaco(gll_nodes, p) @@ -151,9 +145,6 @@ subroutine test_BD_QuadraturePointData_5node() ! **** primary function being tested ***** call BD_QuadraturePointDataAt0( p ) - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: rrN0" - @assertEqual(baseline_rrN0(:,:,1), p%rrN0(:,:,1), tolerance, testname) - ! Test uu0; only one quadrature point for now testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: uu0" do idx_qp = 1, p%nqp @@ -192,7 +183,7 @@ subroutine test_BD_QuadraturePointData_5node() baseline_uuu(1:3,idx_qp,nelem) = (/ 0.42250000000000015,-0.14787500000000003,0.4774250000000001 /) baseline_uuu(4:6,idx_qp,nelem) = (/ 0.042250000000000024,0.1300000000000001,0.02746250000000002 /) baseline_uup(1:3,idx_qp,nelem) = (/ 0.23717727987485349,-0.005929431996871376,0.2834268494504499 /) - baseline_E1(1:3, idx_qp,nelem) = (/ 0.01384921969632566, 0.33901907914467033, 1.1950929627825897 /) + baseline_E1(1:3, idx_qp,nelem) = (/ 0.018791738328546054, 0.34071428474330018, 1.1956471566614264 /) call BD_DisplacementQP( nelem, p, x, m ) @@ -214,9 +205,9 @@ subroutine test_BD_QuadraturePointData_5node() baseline_kappa(1:3,1,1) = (/ 0.024664714695954715,0.036297077098213545,0.02229356260962948 /) - baseline_RR0(1,1:3,1,nelem) = (/0.7967507798136657,-0.5939809735620473,-0.11124206898740374/) - baseline_RR0(2,1:3,1,nelem) = (/0.5966254150993577,0.7439195402109748,0.3010346022466711 /) - baseline_RR0(3,1:3,1,nelem) = (/-0.09605367730511442,-0.30621939967705303,0.9471026186942948 /) + baseline_RR0(1,1:3,1,nelem) = (/0.79124185715259476, -0.60219094249350502, -0.1063127098163618/) + baseline_RR0(2,1:3,1,nelem) = (/0.60261503127580685, 0.7383322551011402, 0.30285409879630898/) + baseline_RR0(3,1:3,1,nelem) = (/-0.10388189240754285, -0.30369647652886939, 0.94708869836662024/) CALL BD_RotationalInterpQP( nelem, p, x, m ) @@ -242,12 +233,12 @@ subroutine test_BD_QuadraturePointData_5node() enddo enddo ! the following should be the result from MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) - baseline_Stif(1,1:6,idx_qp,nelem) = (/4.5918231909187375, -33.558422946165074, -19.41124878362651, 2.60126686515566, -69.25969416961556, -31.26026770547517 /) - baseline_Stif(2,1:6,idx_qp,nelem) = (/-18.923545538732206, 138.2989541247406, 79.99647091096304, -10.720184539884109, 285.4288856786646, 128.8279349796045 /) - baseline_Stif(3,1:6,idx_qp,nelem) = (/ -13.509458152867301, 98.7311774904666, 57.109222684340786, -7.65310518243836, 203.76676129761876, 91.96984745617996 /) - baseline_Stif(4,1:6,idx_qp,nelem) = (/ 2.852586665816869, -20.847560074045475, -12.058885358769254, 1.6159897420374438, -43.026325677681456, -19.419872917332995 /) - baseline_Stif(5,1:6,idx_qp,nelem) = (/-50.11731488891121, 366.27238899233606, 211.8634858589486, -28.39144827024861, 755.9328304872744, 341.18924335009 /) - baseline_Stif(6,1:6,idx_qp,nelem) = (/-23.86246662028767, 174.39407269994138, 100.87502434184734, -13.518082286573822, 359.9239499295936, 162.45117977068867 /) + baseline_Stif(1,1:6,idx_qp,nelem) = (/4.7536759583339689, -33.907248359179356, -19.542837968671446, 2.9365509821876983, -70.008981029110458, -31.39174980281188/) + baseline_Stif(2,1:6,idx_qp,nelem) = (/-19.401250769011185, 138.38617399872942, 79.760485041818299, -11.984990668437774, 285.72873055166156, 128.11963106880802/) + baseline_Stif(3,1:6,idx_qp,nelem) = (/-13.830884167369799, 98.653595365050748, 56.86015004293688, -8.5439345976052863, 203.69207236173781, 91.33471846615123/) + baseline_Stif(4,1:6,idx_qp,nelem) = (/3.141919298405611, -22.410832986789217, -12.916744914371989, 1.9408992709130821, -46.272099841270119, -20.748226294907653/) + baseline_Stif(5,1:6,idx_qp,nelem) = (/-51.422828167125537, 366.79122036858701, 211.40439684348502, -31.766102251101898, 757.32124637229549, 339.57984728541373/) + baseline_Stif(6,1:6,idx_qp,nelem) = (/-24.340652516975311, 173.61817619702015, 100.06686033300799, -15.036272493606024, 358.4729576086462, 160.73785435679258/) CALL BD_StifAtDeformedQP( nelem, p, m ) @@ -260,9 +251,6 @@ subroutine test_BD_QuadraturePointData_5node() if (allocated(gll_nodes)) deallocate(gll_nodes) if (allocated(baseline_uu0)) deallocate(baseline_uu0) if (allocated(baseline_E10)) deallocate(baseline_E10) - if (allocated(baseline_rrN0)) deallocate(baseline_rrN0) - if (allocated(baseline_rrN0)) deallocate(baseline_rrN0) - if (allocated(baseline_E10)) deallocate(baseline_E10) if (allocated(baseline_uuu)) deallocate(baseline_uuu) if (allocated(baseline_uup)) deallocate(baseline_uup) if (allocated(baseline_E1)) deallocate(baseline_E1) diff --git a/modules/beamdyn/tests/test_tools.F90 b/modules/beamdyn/tests/test_tools.F90 index a2b9fe2f19..9224dfceb9 100644 --- a/modules/beamdyn/tests/test_tools.F90 +++ b/modules/beamdyn/tests/test_tools.F90 @@ -131,10 +131,10 @@ type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, call AllocAry(p%QPtw_ShpDer, p%nqp, p%nodes_per_elem, 'QPtw_ShpDer', ErrStat, ErrMsg) call AllocAry(p%Jacobian, p%nqp, p%elem_total, 'Jacobian', ErrStat, ErrMsg) call AllocAry(p%uuN0, p%dof_node, p%nodes_per_elem, p%elem_total,'uuN0', ErrStat, ErrMsg) + call AllocAry(p%twN0, p%nodes_per_elem, p%elem_total,'twN0', ErrStat, ErrMsg) call AllocAry(p%uu0, p%dof_node, p%nqp, p%elem_total,'uu0', ErrStat, ErrMsg) call AllocAry(p%E10, p%dof_node/2, p%nqp, p%elem_total,'E10', ErrStat, ErrMsg) - call AllocAry(p%rrN0, p%dof_node/2, p%nodes_per_elem, p%elem_total,'rrN0', ErrStat, ErrMsg) CALL AllocAry(p%node_elem_idx,p%elem_total,2,'start and end node numbers of elements in p%node_total sized arrays',ErrStat,ErrMsg) From 1388756e3c1394490348d2c08a95c3177e88d08c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 23 Aug 2023 22:10:52 +0000 Subject: [PATCH 14/61] Can take large time steps, fails before full rot --- modules/beamdyn/src/BeamDyn_Types.f90 | 72 ++++++------ modules/elastodyn/src/ElastoDyn.f90 | 19 +++- modules/nwtc-library/src/ModVar.f90 | 126 +++++++++++++-------- modules/openfast-library/src/FAST_Eval.f90 | 19 ++-- modules/openfast-library/src/Solver.f90 | 107 ++++++++++------- 5 files changed, 210 insertions(+), 133 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 7f2296b79a..4bb2d48a81 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -161,7 +161,8 @@ MODULE BeamDyn_Types 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 :: uuN0 !< Initial Position Vector of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element) [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: twN0 !< Initial Twist 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 = 0.0_R8Ki !< Gravitational acceleration [m/s^2] @@ -182,7 +183,6 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: ShpDer !< Derivative of shape function matrix (index 1 = FE nodes; index 2=quadrature points) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jacobian !< Jacobian value at each quadrature point [-] 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 = 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 [-] @@ -1831,6 +1831,18 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%uuN0 = SrcParamData%uuN0 end if + if (allocated(SrcParamData%twN0)) then + LB(1:2) = lbound(SrcParamData%twN0) + UB(1:2) = ubound(SrcParamData%twN0) + if (.not. allocated(DstParamData%twN0)) then + allocate(DstParamData%twN0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%twN0 = SrcParamData%twN0 + end if if (allocated(SrcParamData%Stif0_QP)) then LB(1:3) = lbound(SrcParamData%Stif0_QP) UB(1:3) = ubound(SrcParamData%Stif0_QP) @@ -1961,18 +1973,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%uu0 = SrcParamData%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 - end if if (allocated(SrcParamData%E10)) then LB(1:3) = lbound(SrcParamData%E10) UB(1:3) = ubound(SrcParamData%E10) @@ -2235,6 +2235,9 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%uuN0)) then deallocate(ParamData%uuN0) end if + if (allocated(ParamData%twN0)) then + deallocate(ParamData%twN0) + end if if (allocated(ParamData%Stif0_QP)) then deallocate(ParamData%Stif0_QP) end if @@ -2265,9 +2268,6 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) 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 @@ -2355,6 +2355,11 @@ subroutine BD_PackParam(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%uuN0), ubound(InData%uuN0)) call RegPack(Buf, InData%uuN0) end if + call RegPack(Buf, allocated(InData%twN0)) + if (allocated(InData%twN0)) then + call RegPackBounds(Buf, 2, lbound(InData%twN0), ubound(InData%twN0)) + call RegPack(Buf, InData%twN0) + end if call RegPack(Buf, allocated(InData%Stif0_QP)) if (allocated(InData%Stif0_QP)) then call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP), ubound(InData%Stif0_QP)) @@ -2415,11 +2420,6 @@ subroutine BD_PackParam(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%uu0), ubound(InData%uu0)) call RegPack(Buf, InData%uu0) end if - 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 call RegPack(Buf, allocated(InData%E10)) if (allocated(InData%E10)) then call RegPackBounds(Buf, 3, lbound(InData%E10), ubound(InData%E10)) @@ -2600,6 +2600,20 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uuN0) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%twN0)) deallocate(OutData%twN0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%twN0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%twN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%twN0) + if (RegCheckErr(Buf, RoutineName)) return + end if if (allocated(OutData%Stif0_QP)) deallocate(OutData%Stif0_QP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2760,20 +2774,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uu0) if (RegCheckErr(Buf, RoutineName)) return end if - 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 if (allocated(OutData%E10)) deallocate(OutData%E10) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 1d687ed830..4c48030e93 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -67,6 +67,8 @@ MODULE ElastoDyn PUBLIC :: ED_PackStateValues, ED_UnpackStateValues PUBLIC :: ED_PackInputValues, ED_UnpackInputValues PUBLIC :: ED_PackOutputValues + + PUBLIC :: ED_UpdateAzimuth CONTAINS @@ -248,8 +250,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Platform reference point wrt to global origin (0,0,0) InitOut%PlatformPos = x%QT(1:6) - ! CALL SmllRotTrans('initial platform rotation', x%QT(4), x%QT(5), x%QT(6), TransMat, '', ErrStat2, ErrMsg2) - TransMat = wm_to_dcm(wm_from_xyz([x%QT(DOF_R), x%QT(DOF_P), x%QT(DOF_Y)])) + CALL SmllRotTrans('initial platform rotation', x%QT(4), x%QT(5), x%QT(6), TransMat, '', ErrStat2, ErrMsg2) InitOut%PlatformPos(1) = InitOut%PlatformPos(1) - TransMat(3,1)*p%PtfmRefzt InitOut%PlatformPos(2) = InitOut%PlatformPos(2) - TransMat(3,2)*p%PtfmRefzt InitOut%PlatformPos(3) = InitOut%PlatformPos(3) - TransMat(3,3)*p%PtfmRefzt + p%PtfmRefzt @@ -825,6 +826,20 @@ SUBROUTINE ED_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat END SUBROUTINE ED_UpdateStates + +!> Limit azimuth to be between 0 and 2pi +SUBROUTINE ED_UpdateAzimuth(p, x, DT) + TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ED_ContinuousStateType), INTENT(INOUT) :: x + real(DbKi), INTENT(IN ) :: DT + + ! If the generator degree of freedom is not active, update the azimuth angle + IF (.not. p%DOF_Flag(DOF_GeAz)) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) + DT*x%QDT(DOF_GeAz) + + ! If the azimuth is greater than 2pi, subtract 2pi + IF ((x%QT(DOF_GeAz) + x%QT(DOF_DrTr)) >= TwoPi_D) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) - TwoPi_D +END SUBROUTINE + !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. !! This SUBROUTINE is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 877a139ecd..4eef2f42a3 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -51,7 +51,7 @@ module ModVar public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields -public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_from_xyz, wm_inv +public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv public :: MV_FieldString contains @@ -442,8 +442,8 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) i = iLin - j ! index of start of WM parameters (3) iLoc = Var%iLoc(i:i + 2) ! array index vector WMp = 0.0_R8Ki ! Init WM perturbation to zero - WMp(j + 1) = 4.0_R8Ki*tan(Perturb/4.0_R8Ki) ! WM perturbation around X,Y,Z axis - ! WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + ! WMp(j + 1) = 4.0_R8Ki*tan(Perturb/4.0_R8Ki) ! WM perturbation around X,Y,Z axis + WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis WM = PerturbAry(iLoc) ! Current WM parameters value PerturbAry(iLoc) = wm_compose(WM, WMp) ! Compose value and perturbation else @@ -476,7 +476,8 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) ! Calculate change in rotation in XYZ in radians - DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) + ! DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) + DiffAry(ind) = DeltaWM end do else @@ -744,7 +745,7 @@ function string_equal_ci(s1, s2) result(is_equal) ! Rotation Utilities !------------------------------------------------------------------------------- -pure function dcm_to_quat(R) result(q) +pure function quat_from_dcm(R) result(q) real(R8Ki), intent(in) :: R(3, 3) real(R8Ki) :: q(4), C integer(IntKi) :: j @@ -770,6 +771,7 @@ pure function dcm_to_quat(R) result(q) q = [(R(2, 3) - R(3, 2)), (R(3, 1) - R(1, 3)), (R(1, 2) - R(2, 1)), C] end select q = q/(2.0_R8Ki*sqrt(C)) + if (q(4) < 0.0_R8Ki) q = -q end function pure function quat_to_dcm(q) result(R) @@ -807,28 +809,84 @@ pure function wm_from_quat(q) result(c) ! R = quat_to_dcm(wm_to_quat(c)) ! end function +! pure function wm_to_dcm(c) result(R) +! real(R8Ki), intent(in) :: c(3) +! real(R8Ki) :: R(3, 3), cct, F(3, 3) +! integer(IntKi) :: i, j +! cct = dot_product(c, c) +! F = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3])/2.0_R8Ki +! do i = 1, 3 +! F(i, i) = F(i, i) + 1.0_R8Ki - cct/16.0_R8Ki +! do j = 1, 3 +! F(i, j) = F(i, j) + c(i)*c(j)/8.0_R8Ki +! end do +! end do +! F = F/(1.0_R8Ki + cct/16.0_R8Ki) +! R = matmul(F, F) +! end function + pure function wm_to_dcm(c) result(R) real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: R(3, 3), cct, F(3, 3) + real(R8Ki) :: R(3, 3), c0, vc, ct(3, 3) integer(IntKi) :: i, j - cct = dot_product(c, c) - F = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3])/2.0_R8Ki + ct(1,:) = [0.0_R8Ki, -c(3), c(2)] + ct(2,:) = [c(3), 0.0_R8Ki, -c(1)] + ct(3,:) = [-c(2), c(1), 0.0_R8Ki] + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + vc = 2.0_R8Ki/(4.0_R8Ki - c0) + R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki do i = 1, 3 - F(i, i) = F(i, i) + 1.0_R8Ki - cct/16.0_R8Ki - do j = 1, 3 - F(i, j) = F(i, j) + c(i)*c(j)/8.0_R8Ki - end do + R(i, i) = R(i, i) + 1.0_R8Ki end do - F = F/(1.0_R8Ki + cct/16.0_R8Ki) - R = matmul(F, F) end function +! pure function wm_from_dcm(R) result(c) +! real(R8Ki), intent(in) :: R(3, 3) +! real(R8Ki) :: c(3), cct +! c = wm_from_quat(quat_from_dcm(R)) +! end function + pure function wm_from_dcm(R) result(c) real(R8Ki), intent(in) :: R(3, 3) - real(R8Ki) :: c(3), cct - c = wm_from_quat(dcm_to_quat(R)) - cct = dot_product(c, c) - if (cct > 16.0_R8Ki) c = 16.0_R8Ki*c/cct + real(R8Ki) :: pivot(4) ! Trace of the rotation matrix and diagonal elements + real(R8Ki) :: sm(0:3) + real(R8Ki) :: em + real(R8Ki) :: Rr(3, 3), c(3) + integer :: i ! case indicator + + Rr = R + + ! mjs--find max value of T := Tr(Rr) and diagonal elements of Rr + ! This tells us which denominator is largest (and less likely to produce numerical noise) + pivot = (/Rr(1, 1) + Rr(2, 2) + Rr(3, 3), Rr(1, 1), Rr(2, 2), Rr(3, 3)/) + i = maxloc(pivot, 1) - 1 ! our sm array starts at 0, so we need to subtract 1 here to get the correct index + + select case (i) + case (3) + sm(0) = Rr(2, 1) - Rr(1, 2) ! 4 c_0 c_3 t_{r0} + sm(1) = Rr(1, 3) + Rr(3, 1) ! 4 c_1 c_3 t_{r0} + sm(2) = Rr(2, 3) + Rr(3, 2) ! 4 c_2 c_3 t_{r0} + sm(3) = 1.0_R8Ki - Rr(1, 1) - Rr(2, 2) + Rr(3, 3) ! 4 c_3 c_3 t_{r0} + case (2) + sm(0) = Rr(1, 3) - Rr(3, 1) ! 4 c_0 c_2 t_{r0} + sm(1) = Rr(1, 2) + Rr(2, 1) ! 4 c_1 c_2 t_{r0} + sm(2) = 1.0_R8Ki - Rr(1, 1) + Rr(2, 2) - Rr(3, 3) ! 4 c_2 c_2 t_{r0} + sm(3) = Rr(2, 3) + Rr(3, 2) ! 4 c_3 c_2 t_{r0} + case (1) + sm(0) = Rr(3, 2) - Rr(2, 3) ! 4 c_0 c_1 t_{r0} + sm(1) = 1.0_R8Ki + Rr(1, 1) - Rr(2, 2) - Rr(3, 3) ! 4 c_1 c_1 t_{r0} + sm(2) = Rr(1, 2) + Rr(2, 1) ! 4 c_2 c_1 t_{r0} + sm(3) = Rr(1, 3) + Rr(3, 1) ! 4 c_3 c_1 t_{r0} + case (0) + sm(0) = 1.0_R8Ki + Rr(1, 1) + Rr(2, 2) + Rr(3, 3) ! 4 c_0 c_0 t_{r0} + sm(1) = Rr(3, 2) - Rr(2, 3) ! 4 c_1 c_0 t_{r0} + sm(2) = Rr(1, 3) - Rr(3, 1) ! 4 c_2 c_0 t_{r0} + sm(3) = Rr(2, 1) - Rr(1, 2) ! 4 c_3 c_0 t_{r0} + end select + + em = sm(0) + SIGN(2.0_R8Ki*SQRT(sm(i)), sm(0)) + em = 4.0_R8Ki/em ! 1 / ( 4 t_{r0} c_{i} ), assuming 0 <= c_0 < 4 and c_{i} > 0 + c = em*sm(1:3) end function ! pure function wm_from_dcm(R) result(c) @@ -853,46 +911,18 @@ pure function wm_compose(p, q) result(r) D1 = (4.0_R8Ki - p0)*(4.0_R8Ki - q0) D2 = p0*q0 - dot_product(p, q) if (D2 >= 0.0_R8Ki) then - r = 4*(q0*p + p0*q + cross(p, q))/(D1 + D2) + r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 + D2) else - r = -4*(q0*p + p0*q + cross(p, q))/(D1 - D2) + r = -4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 - D2) end if end function -pure function wm_to_zyx(c) result(zyx) - real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: zyx(3) - real(R8Ki) :: q(4), qx, qy, qz, qw - q = wm_to_quat(c) - qx = q(1); qy = q(2); qz = q(3); qw = q(4) - zyx(1) = atan2(2*(qw*qx + qy*qz), 1.0_R8Ki - 2.0_R8Ki*(qx*qx + qy*qy)) - zyx(2) = -PiBy2_D + 2.0_R8Ki*atan2(sqrt(1.0_R8Ki + 2.0_R8Ki*(qw*qy - qx*qz)), & - sqrt(1.0_R8Ki - 2.0_R8Ki*(qw*qy - qx*qz))) - zyx(3) = atan2(2.0_R8Ki*(qw*qz + qx*qy), 1.0_R8Ki - 2.0_R8Ki*(qy*qy + qz*qz)) -end function - -function wm_to_xyz(c) result(xyz) - real(R8Ki), intent(in) :: c(3) - real(R8Ki) :: xyz(3) - xyz = EulerExtract(wm_to_dcm(c)) -end function - pure function wm_inv(c) result(cinv) real(R8Ki), intent(in) :: c(3) real(R8Ki) :: cinv(3) cinv = -c end function -pure function wm_from_xyz(xyz) result(c) - real(R8Ki), intent(in) :: xyz(3) - real(R8Ki) :: c(3) - real(R8Ki) :: n(3) - c = 0.0_R8Ki - c = wm_compose([4, 0, 0]*tan(xyz(1)/4.0_R8Ki), c) ! X - c = wm_compose([0, 4, 0]*tan(xyz(2)/4.0_R8Ki), c) ! Y - c = wm_compose([0, 0, 4]*tan(xyz(3)/4.0_R8Ki), c) ! Z -end function - pure function cross(a, b) result(c) real(R8Ki), intent(in) :: a(3), b(3) real(R8Ki) :: c(3) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 363fc794a0..981bccfcfb 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -237,6 +237,7 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_T case (Module_BD) + ! If tight coupling states are supplied, transfer to module if (present(x_TC)) then call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) @@ -245,12 +246,16 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_T case (Module_ED) + ! If tight coupling states are supplied, transfer to module if (present(x_TC)) then call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) call XferGblToLoc1D(Mod%ixs, x_TC, T%ED%m%Vals%x) call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(STATE_PRED)) end if + ! Update the azimuth angle in ED + call ED_UpdateAzimuth(T%ED%p, T%ED%x(STATE_PRED), T%p_FAST%DT) + ! case (Module_ExtPtfm) ! case (Module_FEAM) ! case (Module_HD) @@ -873,18 +878,14 @@ logical function Failed() end function end subroutine -subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData(:) !< Module data - type(FAST_TurbineType), intent(inout) :: T !< Turbine type +subroutine FAST_SaveStates(Mod, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - integer(IntKi) :: i - ! Loop through modules in ModData and copy state from predicted to current with MESH_UPDATECOPY - do i = 1, size(ModData) - call FAST_CopyStates(ModData(i), T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) - if (ErrStat >= AbortErrLev) return - end do + ! Copy state from predicted to current with MESH_UPDATECOPY + call FAST_CopyStates(Mod, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) end subroutine subroutine XferLocToGbl1D(Inds, Loc, Gbl) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 745b4003dc..6708cc2d0d 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -391,20 +391,21 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Debug !---------------------------------------------------------------------------- + munit = -1 + call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return - ! call GetNewUnit(munit, ErrStat2, ErrMsg2); if (Failed()) return - write (m%DebugUnit, *) "NumX = ", NumX write (m%DebugUnit, *) "NumU = ", NumU write (m%DebugUnit, *) "NumY = ", NumY - write (m%DebugUnit, *) "NumY = ", NumY - write (m%DebugUnit, *) "NumJac = ", NumY + write (m%DebugUnit, *) "NumJac = ", NumJac write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL + write (m%DebugUnit, '(A,*(I4))') " p%iX2Tight = ", p%iX2Tight + write (m%DebugUnit, '(A,*(I4))') " p%iX1Tight = ", p%iX1Tight write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight @@ -910,8 +911,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM Turbine, ErrStat2, ErrMsg2, m%xn); if (Failed()) return call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_MapOutputs(Mods(p%iModOpt2(i)), m%Mappings, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + if (i < 2) then + call FAST_MapOutputs(Mods(p%iModOpt2(i)), m%Mappings, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end if end do ! Get inputs and update states for Option 1 modules not in Option 2 @@ -945,7 +948,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call FAST_CalcOutput(Mods(p%iModOpt1(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do - call PackModuleOutputs(Mods, p%iModOpt1, Turbine, m%y) + ! call PackModuleOutputs(Mods, p%iModOpt1, Turbine, m%y) !---------------------------------------------------------------------- ! If iteration limit reached, exit loop @@ -953,6 +956,22 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM if (iterConv >= p%MaxConvIter) exit + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-eps = ", pack(Turbine%BD%m(1)%qp%E1(1:3,:,1) - Turbine%BD%m(1)%qp%RR0(1:3,3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3,:,1) - Turbine%BD%m(1)%qp%RR0(1:3,3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-kappa = ", pack(Turbine%BD%m(1)%qp%kappa(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Nrrr = ", pack(Turbine%BD%m(1)%Nrrr(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%p(1)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1))) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1))) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%p(1)%Glb_crv + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1)) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1)) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1), .true.) + + !---------------------------------------------------------------------- ! Update Jacobian !---------------------------------------------------------------------- @@ -963,7 +982,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0)) then call Solver_BuildJacobian(p, m, Mods, t_global_next, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - write (m%DebugUnit, *) "BuildJacobian = 1" end if !---------------------------------------------------------------------- @@ -972,7 +990,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Calculate continuous state derivatives for tight coupling modules do i = 1, size(p%iModTC) - call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_PRED, & + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return end do @@ -1001,27 +1019,29 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Solve for state and input perturbations !---------------------------------------------------------------------- + write (m%DebugUnit, '(A,*(ES16.7))') " XB = ", m%XB + ! Solve Jacobian and RHS call LAPACK_getrs('N', size(m%Jac, 1), m%Jac, m%IPIV, m%XB, ErrStat2, ErrMsg2); if (Failed()) return - ! Remove conditioning - m%XB(p%iJL, 1) = m%XB(p%iJL, 1)*p%Scale_UJac - !---------------------------------------------------------------------- ! Check perturbations for convergence and exit if below tolerance !---------------------------------------------------------------------- - delta_norm = TwoNorm(m%XB(:, 1)) + delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) - write (m%DebugUnit, '(A,*(ES16.7))') " m%y = ", m%y - write (m%DebugUnit, '(A,*(ES16.7))') " m%un-1 = ", m%un - write (m%DebugUnit, '(A,*(ES16.7))') " m%u_tmp = ", m%u_tmp - write (m%DebugUnit, '(A,*(ES16.7))') " m%UDiff = ", m%UDiff - write (m%DebugUnit, '(A,*(ES16.7))') " m%xn-1 = ", m%xn + write (m%DebugUnit, '(A,*(ES16.7))') " y = ", m%y + write (m%DebugUnit, '(A,*(ES16.7))') " u = ", m%un + write (m%DebugUnit, '(A,*(ES16.7))') " u_tmp = ", m%u_tmp + write (m%DebugUnit, '(A,*(ES16.7))') " U = ", m%UDiff + write (m%DebugUnit, '(A,*(ES16.7))') " x = ", m%xn write (m%DebugUnit, *) "delta_norm = ", delta_norm if (delta_norm < p%ConvTol) exit + ! Remove conditioning + m%XB(p%iJL, 1) = m%XB(p%iJL, 1)*p%Scale_UJac + !---------------------------------------------------------------------- ! Update State for Tight Coupling modules !---------------------------------------------------------------------- @@ -1064,10 +1084,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer updated states and inputs to relevant modules !---------------------------------------------------------------------- - ! write (m%DebugUnit, '(A,*(ES16.7))') " m%du = ", m%du - ! write (m%DebugUnit, '(A,*(ES16.7))') " m%un-2 = ", m%un - ! write (m%DebugUnit, '(A,*(ES16.7))') " m%dx = ", m%dx - ! write (m%DebugUnit, '(A,*(ES16.7))') " m%xn-2 = ", m%xn + write (m%DebugUnit, '(A,*(ES16.7))') " du = ", m%du + write (m%DebugUnit, '(A,*(ES16.7))') " dx = ", m%dx end do @@ -1085,7 +1103,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------------- ! Copy the final predicted states from step t_global_next to actual states for that step - call FAST_SaveStates(Mods, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%iModAll) + call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do ! Save new state m%x = m%xn @@ -1143,7 +1163,8 @@ subroutine ComputeDiffU(Mods, ModOrder, PosAry, NegAry, DiffAry) DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) ! Calculate change in rotation in XYZ in radians - DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) + ! DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) + DiffAry(ind) = DeltaWM end do else @@ -1220,18 +1241,6 @@ subroutine Solver_BuildJacobian(p, m, ModData, this_time, Turbine, ErrStat, ErrM ! m%G = m%dUdu + matmul(m%dUdy, m%dYdu) m%G = m%dUdu call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%dUdy, m%dYdu, 1.0_R8Ki, m%G, ErrStat2, ErrMsg2); if (Failed()) return - - ! call DumpMatrix(munit, "dUdu.bin", m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dUdy.bin", m%dUdy, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "ED-dXdu.bin", Turbine%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "ED-dXdx.bin", Turbine%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "ED-dYdu.bin", Turbine%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "ED-dYdx.bin", Turbine%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "BD-dXdu.bin", Turbine%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "BD-dXdx.bin", Turbine%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "BD-dYdu.bin", Turbine%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "BD-dYdx.bin", Turbine%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - !---------------------------------------------------------------------------- ! Assemble Jacobian !---------------------------------------------------------------------------- @@ -1272,6 +1281,26 @@ subroutine Solver_BuildJacobian(p, m, ModData, this_time, Turbine, ErrStat, ErrM m%Jac(p%iJL, :) = m%Jac(p%iJL, :)/p%Scale_UJac m%Jac(:, p%iJL) = m%Jac(:, p%iJL)*p%Scale_UJac + ! if (munit == -1) then + ! call GetNewUnit(munit, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dUdu.bin", m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dUdy.bin", m%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dXdu.bin", m%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dXdx.bin", m%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dYdu.bin", m%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "dYdx.bin", m%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "ED-dXdu.bin", Turbine%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "ED-dXdx.bin", Turbine%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "ED-dYdu.bin", Turbine%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "ED-dYdx.bin", Turbine%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "BD-dXdu.bin", Turbine%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "BD-dXdx.bin", Turbine%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "BD-dYdu.bin", Turbine%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! ! call DumpMatrix(munit, "BD-dYdx.bin", Turbine%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "J.bin", m%Jac, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "G.bin", m%G, ErrStat2, ErrMsg2); if (Failed()) return + ! end if + ! Factor jacobian matrix call LAPACK_getrf(size(m%Jac, 1), size(m%Jac, 1), m%Jac, m%IPIV, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1334,7 +1363,8 @@ subroutine AddDeltaToStates(Mods, ModOrder, dx, x) ! Compose WM components (dx is in radians) do k = 1, size(Var%iGblSol), 3 ind = Var%iGblSol(k:k + 2) - x(ind) = wm_compose(4.0_R8Ki*tan(dx(ind)/4.0_R8Ki), x(ind)) + ! x(ind) = wm_compose(4.0_R8Ki*tan(dx(ind)/4.0_R8Ki), x(ind)) + x(ind) = wm_compose(dx(ind), x(ind)) end do end select end associate @@ -1376,7 +1406,8 @@ subroutine AddDeltaToInputs(Mods, ModOrder, du, u) ! Compose WM components (du is in radians) do k = 1, size(Var%iGblSol), 3 ind = Var%iGblSol(k:k + 2) - u(ind) = wm_compose(4.0_R8Ki*tan(du(ind)/4.0_R8Ki), u(ind)) + ! u(ind) = wm_compose(4.0_R8Ki*tan(du(ind)/4.0_R8Ki), u(ind)) + u(ind) = wm_compose(du(ind), u(ind)) end do end select From 623ebe267e07970c7a60c04fb417166dce7a9de5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 25 Aug 2023 16:32:17 +0000 Subject: [PATCH 15/61] Attempting to reset BeamDyn states --- modules/beamdyn/src/BeamDyn.f90 | 12 +- modules/nwtc-library/src/ModVar.f90 | 45 ++++-- modules/openfast-library/src/Solver.f90 | 206 +++++++++++++++++------- 3 files changed, 191 insertions(+), 72 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 62340fd3cc..330e824fea 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -2269,7 +2269,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ENDIF ! Calculate internal forces and moments - CALL BD_InternalForceMoment( x, p, m ) + CALL BD_InternalForceMoment( x_tmp, p, m ) ! Transfer the FirstNodeReaction forces to the output ReactionForce y%ReactionForce%Force(:,1) = MATMUL(p%GlbRot,m%FirstNodeReactionLclForceMoment(1:3)) @@ -2277,7 +2277,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! set y%BldMotion fields: - CALL Set_BldMotion_Mesh( p, m%u2, x, m, y) + CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, m, y) !------------------------------------------------------- ! compute RootMxr and RootMyr for ServoDyn and @@ -2371,10 +2371,10 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL BD_CopyContState(x, dxdt, MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - dxdt%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) - CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, dxdt%q( 4:6,1), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! dxdt%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + ! CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, dxdt%q( 4:6,1), ErrStat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! if (ErrStat >= AbortErrLev) return !dxdt%q( 4:6,1) = ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p) dxdt%dqdt(1:3,1) = m%u%RootMotion%TranslationVel(:,1) dxdt%dqdt(4:6,1) = m%u%Rootmotion%RotationVel(:,1) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 4eef2f42a3..1811adba53 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -51,7 +51,7 @@ module ModVar public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields -public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv +public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_xyz, wm_from_xyz public :: MV_FieldString contains @@ -438,14 +438,13 @@ subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) ! If variable field is orientation, perturbation is in WM parameters if (Var%Field == VF_Orientation) then - j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) - i = iLin - j ! index of start of WM parameters (3) - iLoc = Var%iLoc(i:i + 2) ! array index vector - WMp = 0.0_R8Ki ! Init WM perturbation to zero - ! WMp(j + 1) = 4.0_R8Ki*tan(Perturb/4.0_R8Ki) ! WM perturbation around X,Y,Z axis - WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis - WM = PerturbAry(iLoc) ! Current WM parameters value - PerturbAry(iLoc) = wm_compose(WM, WMp) ! Compose value and perturbation + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = iLin - j ! index of start of WM parameters (3) + iLoc = Var%iLoc(i:i + 2) ! array index vector + WMp = 0.0_R8Ki ! Init WM perturbation to zero + WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + WM = PerturbAry(iLoc) ! Current WM parameters value + PerturbAry(iLoc) = wm_compose(WM, wm_from_xyz(WMp)) ! Compose value and perturbation else PerturbAry(Var%iLoc(iLin)) = PerturbAry(Var%iLoc(iLin)) + Perturb end if @@ -476,8 +475,7 @@ subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) ! Calculate change in rotation in XYZ in radians - ! DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) - DiffAry(ind) = DeltaWM + DiffAry(ind) = wm_to_xyz(DeltaWM) ! store delta as radians end do else @@ -889,6 +887,31 @@ pure function wm_from_dcm(R) result(c) c = em*sm(1:3) end function +pure function wm_to_xyz(c) result(xyz) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: phi, n(3), xyz(3), m + m = sqrt(dot_product(c,c)) + if (m == 0.0_R8Ki) then + xyz = 0.0_R8Ki + return + end if + n = c/m + phi = 4.0_R8Ki*atan(m/4.0_R8Ki) + xyz = phi*n +end function + +pure function wm_from_xyz(xyz) result(c) + real(R8Ki), intent(in) :: xyz(3) + real(R8Ki) :: phi, n(3), c(3) + phi = sqrt(dot_product(xyz,xyz)) + if (phi == 0.0_R8Ki) then + c = 0.0_R8Ki + return + end if + n = xyz / phi + c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n +end function + ! pure function wm_from_dcm(R) result(c) ! real(R8Ki), intent(in) :: R(3, 3) ! real(R8Ki) :: c(3), t1, t2, cct diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 6708cc2d0d..016eaed2d1 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -553,6 +553,8 @@ subroutine Solver_DefineMappings(Mappings, Mods, ErrStat, ErrMsg) SrcMod => Mods(Mappings(iMap)%SrcModIdx), & DstMod => Mods(Mappings(iMap)%DstModIdx)) + ! TODO: Add logic to check if mesh exists, skip mapping if it doesn't exist + ! If load mapping if (map%IsLoad) then @@ -713,9 +715,7 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Transfer initial state from modules to solver call PackModuleStates(ModData(p%iModTC), STATE_CURR, Turbine, x=m%x) - ! Transfer initial state to next state q matrix (qn) - ! The qn matrix is being used because the solution step routine predicts - ! the the step starting state, q, from qn. + ! Transfer initial state to state q matrix call Solver_TransferXtoQ(p%ixqd, m%x, m%qn) ! Allocate acceleration array which will be used to check for convergence @@ -791,13 +791,6 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) call FAST_ResetRemapFlags(ModData(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do - !---------------------------------------------------------------------------- - ! Calculate inititial Jacobian - !---------------------------------------------------------------------------- - - ! Calculate the solver Jacobian - call Solver_BuildJacobian(p, m, ModData, t_initial, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - contains function Failed() logical :: Failed @@ -806,6 +799,92 @@ function Failed() end function end subroutine +subroutine UpdateBeamDynGlobalReference(p, m, Mod, T, ErrStat, ErrMsg) + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(inout) :: m !< Misc variables + type(ModDataType), intent(in) :: Mod + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'UpdateBeamDynGlobalReference' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) + real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) + real(R8Ki) :: GlbPos_old(3), GlbPos_new(3), GlbPos_diff(3) + real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) + integer(IntKi) :: i, j, temp_id, temp_id2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Save old global position, rotation, and WM + GlbPos_old = T%BD%p(Mod%Ins)%GlbPos + GlbRot_old = T%BD%p(Mod%Ins)%GlbRot + GlbWM_old = T%BD%p(Mod%Ins)%Glb_crv + + ! Calculate new global position, rotation, and WM from root motion + GlbPos_new = T%BD%Input(1, Mod%Ins)%RootMotion%Position(:, 1) + & + T%BD%Input(1, Mod%Ins)%RootMotion%TranslationDisp(:, 1) + GlbRot_new = transpose(T%BD%Input(1, Mod%Ins)%RootMotion%Orientation(:, :, 1)) + GlbWM_new = wm_from_dcm(GlbRot_new) + + ! Update the module global values + T%BD%p(Mod%Ins)%GlbPos = GlbPos_new + T%BD%p(Mod%Ins)%GlbRot = GlbRot_new + T%BD%p(Mod%Ins)%Glb_crv = GlbWM_new + + ! Calculate differences between old and new reference + GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) + GlbWM_diff = wm_compose(wm_inv(GlbWM_old), GlbWM_new) + GlbPos_diff = GlbPos_old - GlbPos_new + + associate (x_BD => T%BD%x(Mod%Ins, STATE_PRED), p_BD => T%BD%p(Mod%Ins)) + + x_BD%q(:, 1) = 0.0_R8Ki + x_BD%dqdt(1:3, 1) = matmul(GlbRot_diff, T%BD%Input(1, Mod%Ins)%RootMotion%TranslationVel(:, 1)) + x_BD%dqdt(4:6, 1) = matmul(GlbRot_diff, T%BD%Input(1, Mod%Ins)%RootMotion%RotationVel(:, 1)) + + do i = 1, p_BD%elem_total + do j = 1, p_BD%nodes_per_elem + + temp_id = (i - 1)*(p_BD%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. + temp_id2 = (i - 1)*p_BD%nodes_per_elem + j ! Index to a node within element i + + if (temp_id == 1) cycle + + x_BD%q(1:3, temp_id) = GlbPos_old + matmul(GlbRot_old, p_BD%uuN0(1:3, j, i) + x_BD%q(1:3, temp_id)) - & + GlbPos_new - matmul(GlbRot_new, p_BD%uuN0(1:3, j, i)) + + ! Get the absolute position of the node + ! x_BD%q(1:3, temp_id) = matmul(GlbRot_new, (matmul(transpose(GlbRot_old), p_BD%uuN0(1:3, j, i)) - & + ! matmul(transpose(GlbRot_new), p_BD%uuN0(1:3, j, i)))) + & + ! matmul(transpose(GlbRot_diff), x_BD%q(1:3, temp_id)) + + ! Update the node orientation rotation of the node + x_BD%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x_BD%q(4:6, temp_id)) + + ! Update the translational velocity + x_BD%dqdt(1:3, temp_id) = matmul(transpose(GlbRot_diff), x_BD%dqdt(1:3, temp_id)) + + ! Update the rotational velocity + x_BD%dqdt(4:6, temp_id) = matmul(transpose(GlbRot_diff), x_BD%dqdt(4:6, temp_id)) + + end do + end do + + end associate + + ! T%BD%x(Mod%Ins, STATE_PRED)%q = 0 + ! T%BD%x(Mod%Ins, STATE_PRED)%dqdt = 0 + + call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) + call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%x, m%xn) + call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + +end subroutine + subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrMsg) integer(IntKi), intent(in) :: n_t_global !< global time step real(DbKi), intent(in) :: t_initial !< Initial simulation time @@ -857,28 +936,34 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------------- ! Prediction - guess solution state variables at end of time step + ! m%qn contains the states at the end of the last step. + ! m%q contains the prediction which is copied to m%qn at the start of the + ! correction loop. !---------------------------------------------------------------------------- - ! Calculate displacements, velocities, and accelerations for next step - associate (q => m%qn(:, 1), qd => m%qn(:, 2), qdd => m%qn(:, 3), aa => m%qn(:, 4), & - nq => m%q(:, 1), nqd => m%q(:, 2), nqdd => m%q(:, 3), naa => m%q(:, 4)) - nqdd = qdd*p%AccBlend ! Acceleration - naa = ((1.0_R8Ki - p%AlphaF)*nqdd + p%AlphaF*qdd - p%AlphaM*aa)/(1 - p%AlphaM) ! Algorithmic acceleration - nqd = qd + p%DT*(1 - p%Gamma)*aa + p%DT*p%Gamma*naa ! Velocity - nq = q + p%DT*qd + p%DT**2*(0.5 - p%Beta)*aa + p%DT**2*p%Beta*naa ! Displacment - end associate + ! Acceleration for next step + m%q(:, COL_A) = p%AccBlend*m%qn(:, COL_A) - ! Calculate difference in state matrix (q is the updated state matrix now) - m%dq = m%q - m%qn + ! Algorithm acceleration for next step + m%q(:, COL_AA) = ((1.0_R8Ki - p%AlphaF)*m%q(:, COL_A) + & + p%AlphaF*m%qn(:, COL_A) - & + p%AlphaM*m%qn(:, COL_AA))/(1 - p%AlphaM) + + ! Calculate change in position and velocities + ! (position states include orientations which must be composed with deltas) + m%dq = 0.0_R8Ki + m%dq(:, COL_V) = p%DT*(1 - p%Gamma)*m%qn(:, COL_AA) + p%DT*p%Gamma*m%q(:, COL_AA) + m%dq(:, COL_D) = p%DT*m%qn(:, COL_V) + p%DT**2*(0.5 - p%Beta)*m%qn(:, COL_AA) + p%DT**2*p%Beta*m%q(:, COL_AA) ! Transfer delta state matrix to delta x array + m%dx = 0.0_R8Ki call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) ! Add delta to x array to get new states (respect variable fields) ! required for orientation fields in states call AddDeltaToStates(Mods, p%iModTC, m%dx, m%x) - ! Update state matrix with values updated by adding deltas + ! Update state matrix with updated state values call Solver_TransferXtoQ(p%ixqd, m%x, m%q) ! Initialize delta arrays for iterations @@ -935,8 +1020,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Loop through convergence iterations do iterConv = 0, p%MaxConvIter - write (m%DebugUnit, *) "iterConv = ", iterConv - ! Decrement number of iterations before updating the Jacobian m%IterUntilUJac = m%IterUntilUJac - 1 @@ -956,21 +1039,22 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM if (iterConv >= p%MaxConvIter) exit - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-eps = ", pack(Turbine%BD%m(1)%qp%E1(1:3,:,1) - Turbine%BD%m(1)%qp%RR0(1:3,3,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3,:,1) - Turbine%BD%m(1)%qp%RR0(1:3,3,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-kappa = ", pack(Turbine%BD%m(1)%qp%kappa(1:3,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Nrrr = ", pack(Turbine%BD%m(1)%Nrrr(1:3,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%p(1)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1))) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1))) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%p(1)%Glb_crv - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1)) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1)) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1), .true.) + write (m%DebugUnit, *) "iterConv = ", iterConv + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-eps = ", pack(Turbine%BD%m(1)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3,:,1) - Turbine%BD%m(1)%qp%RR0(1:3,3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-kappa = ", pack(Turbine%BD%m(1)%qp%kappa(1:3, :, 1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Nrrr = ", pack(Turbine%BD%m(1)%Nrrr(1:3, :, 1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%p(1)%Glb_crv + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1)) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1)) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%p(1)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1))) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1))) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1), .true.) !---------------------------------------------------------------------- ! Update Jacobian @@ -979,8 +1063,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! If number of iterations or steps until Jacobian is to be updated ! is zero or less, then rebuild the Jacobian. Note: Solver_BuildJacobian ! resets these counters. - if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0)) then - call Solver_BuildJacobian(p, m, Mods, t_global_next, & + if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0) .or. (n_t_global_next == 1)) then + + call Solver_BuildJacobian(p, m, Mods, t_global_next, n_t_global_next*100 + iterConv, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end if @@ -1099,9 +1184,17 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do !---------------------------------------------------------------------------- - ! Update for next step + ! Update states for next step !---------------------------------------------------------------------------- + ! Reset BeamDyn global reference and rescale BeamDyn states + ! Loop through tight coupling modules, if module is BeamDyn, update global ref + do i = 1, size(p%iModTC) + if (Mods(p%iModTC(i))%ID == Module_BD) then + call UpdateBeamDynGlobalReference(p, m, Mods(p%iModTC(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end if + end do + ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(p%iModAll) call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return @@ -1138,7 +1231,7 @@ subroutine ComputeDiffU(Mods, ModOrder, PosAry, NegAry, DiffAry) real(R8Ki), intent(in) :: NegAry(:) ! Negative result array real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference integer(IntKi) :: i, j, k, ind(3) - real(R8Ki) :: DeltaWM(3) + real(R8Ki) :: DeltaWM(3), n(3), phi ! Loop through module index order do i = 1, size(ModOrder) @@ -1163,6 +1256,9 @@ subroutine ComputeDiffU(Mods, ModOrder, PosAry, NegAry, DiffAry) DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) ! Calculate change in rotation in XYZ in radians + ! phi = TwoNorm(DeltaWM) + ! n = DeltaWM/phi + ! DiffAry(ind) = 4.0_R8Ki*atan(phi/4.0_R8Ki)*n ! DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) DiffAry(ind) = DeltaWM end do @@ -1177,11 +1273,12 @@ subroutine ComputeDiffU(Mods, ModOrder, PosAry, NegAry, DiffAry) end do end subroutine -subroutine Solver_BuildJacobian(p, m, ModData, this_time, Turbine, ErrStat, ErrMsg) +subroutine Solver_BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inOUT) :: m !< Misc variables - type(ModDataType), intent(in) :: ModData(:) !< Array of module data + type(ModDataType), intent(in) :: Mods(:) !< Array of module data real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: iter type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1214,18 +1311,18 @@ subroutine Solver_BuildJacobian(p, m, ModData, this_time, Turbine, ErrStat, ErrM ! Calculate dYdx, dXdx, dXdu for tight coupling modules do i = 1, size(p%iModTC) - call FAST_CalcJacobian(ModData(p%iModTC(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_CalcJacobian(Mods(p%iModTC(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & dYdx=m%dYdx, dXdx=m%dXdx, dXdu=m%dXdu); if (Failed()) return end do ! Calculate dYdu Loop for Option 1 modules do i = 1, size(p%iModOpt1) - call FAST_CalcJacobian(ModData(p%iModOpt1(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_CalcJacobian(Mods(p%iModOpt1(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & dYdu=m%dYdu); if (Failed()) return end do ! Calculate dUdu and dUdy for Option 1 meshes - call FAST_LinearizeMappings(ModData, p%iModOpt1, m%Mappings, Turbine, ErrStat2, ErrMsg2, & + call FAST_LinearizeMappings(Mods, p%iModOpt1, m%Mappings, Turbine, ErrStat2, ErrMsg2, & dUdu=m%dUdu, dUdy=m%dUdy); if (Failed()) return !---------------------------------------------------------------------------- @@ -1293,13 +1390,13 @@ subroutine Solver_BuildJacobian(p, m, ModData, this_time, Turbine, ErrStat, ErrM ! ! call DumpMatrix(munit, "ED-dXdx.bin", Turbine%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return ! ! call DumpMatrix(munit, "ED-dYdu.bin", Turbine%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return ! ! call DumpMatrix(munit, "ED-dYdx.bin", Turbine%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "BD-dXdu.bin", Turbine%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "BD-dXdx.bin", Turbine%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "BD-dYdu.bin", Turbine%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "BD-dYdx.bin", Turbine%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "J.bin", m%Jac, ErrStat2, ErrMsg2); if (Failed()) return ! call DumpMatrix(munit, "G.bin", m%G, ErrStat2, ErrMsg2); if (Failed()) return ! end if + ! call DumpMatrix(munit, "jacs/BD-dXdu-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "jacs/BD-dXdx-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "jacs/BD-dYdu-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "jacs/BD-dYdx-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + ! call DumpMatrix(munit, "jacs/J-"//trim(num2lstr(iter))//".bin", m%Jac, ErrStat2, ErrMsg2); if (Failed()) return ! Factor jacobian matrix call LAPACK_getrf(size(m%Jac, 1), size(m%Jac, 1), m%Jac, m%IPIV, ErrStat2, ErrMsg2) @@ -1341,6 +1438,7 @@ subroutine AddDeltaToStates(Mods, ModOrder, dx, x) character(*), parameter :: RoutineName = 'AddDeltaToStates' integer(IntKi) :: iMod, iIns integer(IntKi) :: i, j, k, ind(3) + real(R8Ki) :: n(3), phi ! Loop through modules in order do i = 1, size(ModOrder) @@ -1363,8 +1461,7 @@ subroutine AddDeltaToStates(Mods, ModOrder, dx, x) ! Compose WM components (dx is in radians) do k = 1, size(Var%iGblSol), 3 ind = Var%iGblSol(k:k + 2) - ! x(ind) = wm_compose(4.0_R8Ki*tan(dx(ind)/4.0_R8Ki), x(ind)) - x(ind) = wm_compose(dx(ind), x(ind)) + x(ind) = wm_compose(wm_from_xyz(dx(ind)), x(ind)) ! dx is in radians end do end select end associate @@ -1406,8 +1503,7 @@ subroutine AddDeltaToInputs(Mods, ModOrder, du, u) ! Compose WM components (du is in radians) do k = 1, size(Var%iGblSol), 3 ind = Var%iGblSol(k:k + 2) - ! u(ind) = wm_compose(4.0_R8Ki*tan(du(ind)/4.0_R8Ki), u(ind)) - u(ind) = wm_compose(du(ind), u(ind)) + u(ind) = wm_compose(wm_from_xyz(du(ind)), u(ind)) ! du is in radians end do end select From 381aac17906f9dd8f3e99294b4b88319d3ab58b9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 25 Aug 2023 16:59:01 +0000 Subject: [PATCH 16/61] Maybe working? --- modules/beamdyn/src/BeamDyn_Subs.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index b0006dafd1..234efb4a62 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -655,7 +655,8 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, m, y) ! Calculate the translational displacement of each GLL node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationDisp(1:3,temp_id2) = MATMUL(p%GlbRot,x%q(1:3,temp_id)) + y%BldMotion%TranslationDisp(1:3,temp_id2) = p%GlbPos + matmul(p%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uuN0(1:3, j, i)) !bjj: note differences here compared to BDrot_to_FASTdcm !adp: in BDrot_to_FASTdcm we are assuming that x%q(4:6,:) is zero because there is no rotatinoal displacement yet @@ -689,7 +690,9 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, m, y) ! Calculate the translational displacement of each quadrature node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationDisp(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%uuu(1:3,j,i) ) + ! y%BldMotion%TranslationDisp(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%uuu(1:3,j,i) ) + y%BldMotion%TranslationDisp(1:3,temp_id2) = p%GlbPos + matmul(p%GlbRot, p%uu0(1:3, j, i) + m%qp%uuu(1:3,j,i)) - & + y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uu0(1:3, j, i)) !bjj: note differences here compared to BDrot_to_FASTdcm @@ -701,7 +704,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, m, y) CALL BD_CrvMatrixR(cc0,temp_R) ! returns temp_R (the transpose of the DCM orientation matrix) ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) - y%BldMotion%Orientation(1:3,1:3,temp_id2) = TRANSPOSE(temp_R) + y%BldMotion%Orientation(1:3,1:3,temp_id2) = matmul(p%GlbRot, TRANSPOSE(temp_R)) ! Calculate the translation velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. @@ -749,6 +752,10 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) ! now set the accelerations: ! The first node on the mesh is just the root location: + y%BldMotion%TranslationDisp(:,1) = u%RootMotion%TranslationDisp(:,1) + y%BldMotion%Orientation(:,:,1) = u%RootMotion%Orientation(:,:,1) + y%BldMotion%TranslationVel(:,1) = u%RootMotion%TranslationVel(:,1) + y%BldMotion%RotationVel(:,1) = u%RootMotion%RotationVel(:,1) y%BldMotion%TranslationAcc(:,1) = u%RootMotion%TranslationAcc(:,1) y%BldMotion%RotationAcc(:,1) = u%RootMotion%RotationAcc(:,1) From 74e7162758332edab2d8167c32ac1f3dc09c71db Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 25 Aug 2023 17:28:49 +0000 Subject: [PATCH 17/61] Pretty sure it works --- modules/openfast-library/src/Solver.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 016eaed2d1..6c85a3a5e4 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -843,8 +843,8 @@ subroutine UpdateBeamDynGlobalReference(p, m, Mod, T, ErrStat, ErrMsg) associate (x_BD => T%BD%x(Mod%Ins, STATE_PRED), p_BD => T%BD%p(Mod%Ins)) x_BD%q(:, 1) = 0.0_R8Ki - x_BD%dqdt(1:3, 1) = matmul(GlbRot_diff, T%BD%Input(1, Mod%Ins)%RootMotion%TranslationVel(:, 1)) - x_BD%dqdt(4:6, 1) = matmul(GlbRot_diff, T%BD%Input(1, Mod%Ins)%RootMotion%RotationVel(:, 1)) + x_BD%dqdt(1:3, 1) = matmul(transpose(GlbRot_diff), T%BD%Input(1, Mod%Ins)%RootMotion%TranslationVel(:, 1)) + x_BD%dqdt(4:6, 1) = matmul(transpose(GlbRot_diff), T%BD%Input(1, Mod%Ins)%RootMotion%RotationVel(:, 1)) do i = 1, p_BD%elem_total do j = 1, p_BD%nodes_per_elem From 4bb864efa40120ec7f3d6ad1ce3577f160a54ffe Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 28 Aug 2023 14:53:34 +0000 Subject: [PATCH 18/61] Began adding other modules to FAST_Eval --- modules/openfast-library/src/FAST_Eval.f90 | 1079 +++++++++++--------- 1 file changed, 597 insertions(+), 482 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 981bccfcfb..5da518d89e 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -26,12 +26,14 @@ module FAST_Eval use FAST_Solver use FAST_ModTypes use NWTC_LAPACK -use ElastoDyn -use BeamDyn -use SubDyn use AeroDyn -use AeroDyn14 +use BeamDyn +use ElastoDyn +use HydroDyn +use InflowWind +use SeaState use ServoDyn +use SubDyn implicit none @@ -90,11 +92,21 @@ subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) call ED_CopyInput(T%ED%u, T%ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return T%ED%InputTimes(1) = t_global_next -! case (Module_ExtPtfm) -! case (Module_FEAM) -! case (Module_HD) -! case (Module_IceD) -! case (Module_IceF) +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + ! TODO: Fix inconsistent function name (HydroDyn_CopyInput) + call HydroDyn_Input_ExtrapInterp(T%HD%Input, T%HD%InputTimes, T%HD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call HydroDyn_CopyInput(T%HD%Input(j), T%HD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%HD%InputTimes(j + 1) = T%HD%InputTimes(j) + end do + call HydroDyn_CopyInput(T%HD%u, T%HD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%HD%InputTimes(1) = t_global_next + +! case (Module_IceD) +! case (Module_IceF) case (Module_IfW) call InflowWind_Input_ExtrapInterp(T%IfW%Input, T%IfW%InputTimes, T%IfW%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return @@ -105,12 +117,30 @@ subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) call InflowWind_CopyInput(T%IfW%u, T%IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return T%IfW%InputTimes(1) = t_global_next -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) -! case (Module_SD) -! case (Module_SeaSt) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + call SD_Input_ExtrapInterp(T%SD%Input, T%SD%InputTimes, T%SD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 1, -1 + call SD_CopyInput(T%SD%Input(j), T%SD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SD%InputTimes(j + 1) = T%SD%InputTimes(j) + end do + call SD_CopyInput(T%SD%u, T%SD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + T%SD%InputTimes(1) = t_global_next + + case (Module_SeaSt) + + ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input, T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + ! do j = T%p_FAST%InterpOrder, 1, -1 + ! call SeaSt_CopyInput(T%SeaSt%Input(j), T%SeaSt%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! T%SeaSt%InputTimes(j + 1) = T%SeaSt%InputTimes(j) + ! end do + ! call SeaSt_CopyInput(T%SeaSt%u, T%SeaSt%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! T%SeaSt%InputTimes(1) = t_global_next + case (Module_SrvD) call SrvD_Input_ExtrapInterp(T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return @@ -156,7 +186,13 @@ subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) ! Select based on module ID select case (Mod%ID) -! case (Module_AD) + case (Module_AD) + + T%AD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call AD_CopyInput(T%AD%Input(1), T%AD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call AD_CopyInput(T%AD%Input(1), T%AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return case (Module_BD) @@ -174,19 +210,48 @@ subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) end do call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return -! case (Module_ExtPtfm) -! case (Module_FEAM) -! case (Module_HD) -! case (Module_IceD) -! case (Module_IceF) -! case (Module_IfW) -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) -! case (Module_SD) -! case (Module_SeaSt) -! case (Module_SrvD) +! case (Module_ExtPtfm) +! case (Module_FEAM) + case (Module_HD) + + T%HD%InputTimes(:) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call HydroDyn_CopyInput(T%HD%Input(1), T%HD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call HydroDyn_CopyInput(T%HD%Input(1), T%HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_IceD) +! case (Module_IceF) + + case (Module_IfW) + + ! TODO: Fix inconsistent function name + T%IfW%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + T%SD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call SD_CopyInput(T%SD%Input(1), T%SD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call SD_CopyInput(T%SD%Input(1), T%SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + +! case (Module_SeaSt) + case (Module_SrvD) + + T%SrvD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return case default call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) @@ -258,7 +323,15 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_T ! case (Module_ExtPtfm) ! case (Module_FEAM) -! case (Module_HD) + case (Module_HD) + + do j_ss = 1, Mod%SubSteps + n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 + t_module = n_t_module*Mod%DT + t_initial + call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input, T%HD%InputTimes, T%HD%p, T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & + T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), T%HD%m, ErrStat2, ErrMsg2); if (Failed()) return + end do + ! case (Module_IceD) ! case (Module_IceF) case (Module_IfW) @@ -274,7 +347,15 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_T ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) -! case (Module_SD) + case (Module_SD) + + do j_ss = 1, Mod%SubSteps + n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 + t_module = n_t_module*Mod%DT + t_initial + call SD_UpdateStates(t_module, n_t_module, T%SD%Input, T%SD%InputTimes, T%SD%p, T%SD%x(STATE_PRED), & + T%SD%xd(STATE_PRED), T%SD%z(STATE_PRED), T%SD%OtherSt(STATE_PRED), T%SD%m, ErrStat2, ErrMsg2); if (Failed()) return + end do + ! case (Module_SeaSt) case (Module_SrvD) @@ -283,7 +364,6 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_T t_module = n_t_module*Mod%DT + t_initial call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return - if (ErrStat >= AbortErrLev) return end do case default @@ -348,54 +428,67 @@ logical function Failed() end function end subroutine -subroutine FAST_MapOutputs(Mod, Maps, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg +subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_TransferOutputs' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i - integer(IntKi) :: DstIns, SrcIns + character(*), parameter :: RoutineName = 'FAST_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j + integer(IntKi) :: j_ss ! substep loop counter - ! Loop through mappings that use this module's outputs - do i = 1, size(Maps) + ErrStat = ErrID_None + ErrMsg = '' - ! If map doesn't apply to this module, cycle - if (Mod%Idx /= Maps(i)%SrcModIdx) cycle + ! Select based on module ID + select case (Mod%ID) - ! Get source and destination module instances - SrcIns = Maps(i)%SrcIns - DstIns = Maps(i)%DstIns + case (Module_AD) - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Maps(i)%Key) + call AD_CalcOutput(this_time, T%AD%Input(1), T%AD%p, T%AD%x(this_state), T%AD%xd(this_state), T%AD%z(this_state), & + T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep); if (Failed()) return - case ('ED BladeRoot -> BD RootMotion') + case (Module_BD) - call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(DstIns), Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! + call BD_CalcOutput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & + T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & + T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return - case ('BD ReactionForce -> ED HubLoad') + case (Module_ED) - ! u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations - call Transfer_Point_to_Point(T%BD%y(SrcIns)%ReactionForce, Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & - T%BD%Input(1, SrcIns)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return - ! u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force - ! u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + call ED_CalcOutput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2); if (Failed()) return +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) - return - end select + ! TODO: fix inconsistent function signature + call InflowWind_CalcOutput(this_time, T%IfW%Input(1), T%IfW%p, T%IfW%x(this_state), T%IfW%xd(this_state), T%IfW%z(this_state), & + T%IfW%OtherSt(this_state), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return - ! Set flag indicating that mapping has been updated - Maps(i)%Updated = .true. +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) + case (Module_SrvD) - end do + call SrvD_CalcOutput(this_time, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(this_state), T%SrvD%xd(this_state), T%SrvD%z(this_state), & + T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return + + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return + end select contains logical function Failed() @@ -404,286 +497,84 @@ logical function Failed() end function end subroutine -subroutine FAST_UpdateInputs(Mod, Maps, Dst, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - integer(IntKi), intent(in) :: Dst - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg +subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMsg, dxdt) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), optional, intent(out) :: dxdt(:) - character(*), parameter :: RoutineName = 'FAST_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, k - integer(IntKi) :: DstIns, SrcIns - type(ED_InputType), pointer :: u_ED - type(BD_InputType), pointer :: u_BD - logical :: ED_ResetHubPtLoad + character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None ErrMsg = '' - ! Check that Dst is valid - if (Dst /= 1 .and. Dst /= 2) then - call SetErrStat(ErrID_Fatal, "Dst must be 1 or 2, given "//trim(Num2LStr(Dst)), ErrStat, ErrMsg, RoutineName) - return - end if - + ! Select based on module ID select case (Mod%ID) - case (Module_BD) - - select case (Dst) - case (1) - u_BD => T%BD%Input(1, Mod%Ins) - case (2) - u_BD => T%BD%u(Mod%Ins) - end select +! case (Module_AD) - ! u_BD%DistrLoad%Force = 0.0_ReKi - ! u_BD%DistrLoad%Moment = 0.0_ReKi + case (Module_BD) - ! u_BD%PointLoad%Force = 0.0_ReKi - ! u_BD%PointLoad%Moment = 0.0_ReKi + call BD_CalcContStateDeriv(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & + T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & + T%BD%m(Mod%Ins), T%BD%dxdt(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return + if (present(dxdt)) then + call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%dxdt(Mod%Ins), T%BD%m(Mod%Ins)%Vals%dxdt) + call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%dxdt, dxdt) + end if case (Module_ED) - select case (Dst) - case (1) - u_ED => T%ED%Input(1) - case (2) - u_ED => T%ED%u - end select - - ED_ResetHubPtLoad = .true. - - ! u_ED%NacelleLoads%Force = 0.0_ReKi - ! u_ED%NacelleLoads%Moment = 0.0_ReKi - - ! u_ED%TowerPtLoads%Force = 0.0_ReKi - ! u_ED%TowerPtLoads%Moment = 0.0_ReKi - - ! u_ED%TwrAddedMass = 0.0_ReKi - ! u_ED%PtfmAddedMass = 0.0_ReKi + call ED_CalcContStateDeriv(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%m, & + T%ED%dxdt, ErrStat2, ErrMsg2); if (Failed()) return + if (present(dxdt)) then + call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) + call XferLocToGbl1D(Mod%ixs, T%ED%m%Vals%dxdt, dxdt) + end if +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) +! case (Module_SrvD) + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + return end select - ! Loop through mappings that set this module's inputs - do i = 1, size(Maps) - - ! If mapping hasn't been updated, cycle - if (.not. Maps(i)%Updated) cycle - - ! If map doesn't apply to this module, cycle - if (Mod%Idx /= Maps(i)%DstModIdx) cycle - - ! Get source and destination module instances - SrcIns = Maps(i)%SrcIns - DstIns = Maps(i)%DstIns - - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Maps(i)%Key) - - case ('ED BladeRoot -> BD RootMotion') - - call MeshCopy(Maps(i)%MeshTmp, u_BD%RootMotion, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return - - case ('BD ReactionForce -> ED HubLoad') - - if (ED_ResetHubPtLoad) then - u_ED%HubPtLoad%Force = 0.0_ReKi - u_ED%HubPtLoad%Moment = 0.0_ReKi - ED_ResetHubPtLoad = .false. - end if - - u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force - u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment - - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) - return - end select - end do - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMsg, dUdu, dUdy) - type(ModDataType), intent(in) :: ModData(:) !< Module data - integer(IntKi), intent(in) :: ModOrder(:) - type(TC_MappingType), intent(inout) :: Mappings(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - real(R8Ki), optional, intent(inout) :: dUdu(:, :), dUdy(:, :) - - character(*), parameter :: RoutineName = 'FAST_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j, k - integer(IntKi) :: iiu, iiy - - ErrStat = ErrID_None - ErrMsg = '' - - ! Loop through mapping array - do j = 1, size(Mappings) - - ! If mapping input and output modules are not in module order array, cycle - if (all(Mappings(j)%DstModIdx /= ModOrder) .and. all(Mappings(j)%SrcModIdx /= ModOrder)) cycle - - ! Get input/output module instances - iiu = Mappings(j)%DstIns - iiy = Mappings(j)%SrcIns - - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Mappings(j)%Key) - - case ('ED BladeRoot -> BD RootMotion') - call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(iiu), T%BD%Input(1, iiu)%RootMotion, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - - case ('BD ReactionForce -> ED HubLoad') - call Linearize_Point_to_Point(T%BD%y(iiy)%ReactionForce, T%ED%u%HubPtLoad, Mappings(j)%MeshMap, ErrStat2, ErrMsg2, & - T%BD%Input(1, iiy)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return ! <- displaced positions for load calculations - - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Mappings(j)%Key, ErrStat, ErrMsg, RoutineName) - return - end select - - if (present(dUdu)) then - call dUduSetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) - end if - if (present(dUdy)) then - call dUdySetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) - end if - - end do - contains - subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) - type(TC_MappingType), intent(inout) :: M !< Mapping - type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data - type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data - - ! Effect of input Translation Velocity on input Translation Displacement - if (allocated(MML%tv_uD)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%tv_uD, dUdu) - end if - - ! Effect of input Translation Acceleration on input Translation Displacement - if (allocated(MML%ta_uD)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%ta_uD, dUdu) - end if - - ! Effect of input Moments on input Translation Displacement - if (allocated(MML%M_uS)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%u([M%SrcDispVarIdx]), VF_TransDisp, -MML%M_uS, dUdu) - end if - end subroutine - - subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) - type(TC_MappingType), intent(inout) :: M !< Mapping - type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data - type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data - - ! Load identity - if (allocated(MML%li)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Force, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%li, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Moment, -MML%li, dUdy) - end if - - ! Moment to Force - if (allocated(MML%m_f)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%m_f, dUdy) - end if - - ! Moment to output translation displacement - if (allocated(Mappings(j)%MeshMap%dM%m_uD)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) - end if - - ! Motion identity - if (allocated(MML%mi)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%mi, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Orientation, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%mi, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransVel, -MML%mi, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%mi, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransAcc, -MML%mi, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%mi, dUdy) - end if - - ! Translation to Rotation - if (allocated(MML%fx_p)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%fx_p, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%fx_p, dUdy) - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%fx_p, dUdy) - end if - - ! Translation velocity to translation displacement - if (allocated(MML%tv_us)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%tv_us, dUdy) - end if - - ! Translation acceleration to translation displacement - if (allocated(MML%ta_us)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%ta_us, dUdy) - end if - - ! Translation acceleration to angular velocity - if (allocated(MML%ta_rv)) then - call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%ta_us, dUdy) - end if - end subroutine - - subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) - type(ModVarType), intent(in) :: RowVars(:), ColVars(:) - integer(IntKi), intent(in) :: RowField, ColField - real(R8Ki), intent(in) :: Loc(:, :) - real(R8Ki), intent(inout) :: Gbl(:, :) - integer(IntKi) :: ir, ic, m, n, mSize, nSize - m = 1 - do ir = 1, size(RowVars) - if (RowVars(ir)%Field /= RowField) cycle - n = 1 - mSize = RowVars(ir)%Size - do ic = 1, size(ColVars) - if (ColVars(ic)%Field /= ColField) cycle - nSize = ColVars(ic)%Size - Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) = Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) + & - Loc(m:m + mSize - 1, n:n + nSize - 1) - ! write (*, *) 'Rows = ', RowVars(ir)%iGblSol - ! write (*, *) 'Cols = ', ColVars(ic)%iGblSol - ! write (*, *) 'Shape = ', mSize, nSize - ! write (*, '(A,*(ES14.5))') 'Values = ', Loc(m:m + mSize - 1, n:n + nSize - 1) - n = n + nSize - end do - m = m + mSize - end do - end subroutine logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function end subroutine -subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data - real(DbKi), intent(in) :: this_time !< Time - integer(IntKi), intent(in) :: this_state !< State index - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg +subroutine FAST_CalcJacobian(Mod, this_time, this_state, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) + type(ModDataType), intent(in) :: Mod !< Module data + real(DbKi), intent(in) :: this_time !< Time + integer(IntKi), intent(in) :: this_state !< State + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) - character(*), parameter :: RoutineName = 'FAST_CalcOutput' + character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j integer(IntKi) :: j_ss ! substep loop counter ErrStat = ErrID_None @@ -692,21 +583,35 @@ subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) ! Select based on module ID select case (Mod%ID) - case (Module_AD) - - call AD_CalcOutput(this_time, T%AD%Input(1), T%AD%p, T%AD%x(this_state), T%AD%xd(this_state), T%AD%z(this_state), & - T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep); if (Failed()) return +! case (Module_AD) case (Module_BD) - call BD_CalcOutput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & - T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & - T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return + call BD_JacobianPInput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & + T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & + ErrStat2, ErrMsg2, dYdu=T%BD%m(Mod%Ins)%Vals%dYdu, dXdu=T%BD%m(Mod%Ins)%Vals%dXdu); if (Failed()) return + if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%BD%m(Mod%Ins)%Vals%dYdu, dYdu) + if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%BD%m(Mod%Ins)%Vals%dXdu, dXdu) + + call BD_JacobianPContState(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & + T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & + ErrStat2, ErrMsg2, dYdx=T%BD%m(Mod%Ins)%Vals%dYdx, dXdx=T%BD%m(Mod%Ins)%Vals%dXdx); if (Failed()) return + if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dYdx, dYdx) + if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dXdx, dXdx) case (Module_ED) - call ED_CalcOutput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return + if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%ED%m%Vals%dYdu, dYdu) + if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%ED%m%Vals%dXdu, dXdu) + + call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%ED%m%Vals%dYdx, dYdx) + if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%ED%m%Vals%dXdx, dXdx) ! case (Module_ExtPtfm) ! case (Module_FEAM) @@ -720,152 +625,7 @@ subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) ! case (Module_Orca) ! case (Module_SD) ! case (Module_SeaSt) - case (Module_SrvD) - - call SrvD_CalcOutput(this_time, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(this_state), T%SrvD%xd(this_state), T%SrvD%z(this_state), & - T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return - - case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) - return - end select - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMsg, dxdt) - type(ModDataType), intent(in) :: Mod !< Module data - real(DbKi), intent(in) :: this_time !< Time - integer(IntKi), intent(in) :: this_state !< State index - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - real(R8Ki), optional, intent(out) :: dxdt(:) - - character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = '' - - ! Select based on module ID - select case (Mod%ID) - -! case (Module_AD) - - case (Module_BD) - - call BD_CalcContStateDeriv(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & - T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & - T%BD%m(Mod%Ins), T%BD%dxdt(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return - if (present(dxdt)) then - call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%dxdt(Mod%Ins), T%BD%m(Mod%Ins)%Vals%dxdt) - call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%dxdt, dxdt) - end if - - case (Module_ED) - - call ED_CalcContStateDeriv(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%m, & - T%ED%dxdt, ErrStat2, ErrMsg2); if (Failed()) return - if (present(dxdt)) then - call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) - call XferLocToGbl1D(Mod%ixs, T%ED%m%Vals%dxdt, dxdt) - end if - -! case (Module_ExtPtfm) -! case (Module_FEAM) -! case (Module_HD) -! case (Module_IceD) -! case (Module_IceF) -! case (Module_IfW) -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) -! case (Module_SD) -! case (Module_SeaSt) -! case (Module_SrvD) - case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) - return - end select - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -subroutine FAST_CalcJacobian(Mod, this_time, this_state, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) - type(ModDataType), intent(in) :: Mod !< Module data - real(DbKi), intent(in) :: this_time !< Time - integer(IntKi), intent(in) :: this_state !< State - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) - - character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j_ss ! substep loop counter - - ErrStat = ErrID_None - ErrMsg = '' - - ! Select based on module ID - select case (Mod%ID) - -! case (Module_AD) - - case (Module_BD) - - call BD_JacobianPInput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & - T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & - ErrStat2, ErrMsg2, dYdu=T%BD%m(Mod%Ins)%Vals%dYdu, dXdu=T%BD%m(Mod%Ins)%Vals%dXdu); if (Failed()) return - if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%BD%m(Mod%Ins)%Vals%dYdu, dYdu) - if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%BD%m(Mod%Ins)%Vals%dXdu, dXdu) - - call BD_JacobianPContState(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & - T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & - ErrStat2, ErrMsg2, dYdx=T%BD%m(Mod%Ins)%Vals%dYdx, dXdx=T%BD%m(Mod%Ins)%Vals%dXdx); if (Failed()) return - if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dYdx, dYdx) - if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dXdx, dXdx) - - case (Module_ED) - - call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & - ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return - if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%ED%m%Vals%dYdu, dYdu) - if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%ED%m%Vals%dXdu, dXdu) - - call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & - ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return - if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%ED%m%Vals%dYdx, dYdx) - if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%ED%m%Vals%dXdx, dXdx) - -! case (Module_ExtPtfm) -! case (Module_FEAM) -! case (Module_HD) -! case (Module_IceD) -! case (Module_IceF) -! case (Module_IfW) -! case (Module_MAP) -! case (Module_MD) -! case (Module_OpFM) -! case (Module_Orca) -! case (Module_SD) -! case (Module_SeaSt) -! case (Module_SrvD) +! case (Module_SrvD) case default call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) return @@ -955,17 +715,42 @@ subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) ! case (Module_ExtPtfm) ! case (Module_FEAM) -! case (Module_HD) + case (Module_HD) + + ! TODO: Fix inconsistent function name + call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HD_CopyDiscState(T%HD%xd(Src), T%HD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HD_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HD_CopyOtherState(T%HD%OtherSt(Src), T%HD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! case (Module_IceD) ! case (Module_IceF) -! case (Module_IfW) + case (Module_IfW) + + ! call IfW_CopyContState(T%IfW%x(Src), T%IfW%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyDiscState(T%IfW%xd(Src), T%IfW%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyConstrState(T%IfW%z(Src), T%IfW%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call IfW_CopyOtherState(T%IfW%OtherSt(Src), T%IfW%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! case (Module_MAP) ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) -! case (Module_SD) + case (Module_SD) + + call SD_CopyContState(T%SD%x(Src), T%SD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyDiscState(T%SD%xd(Src), T%SD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyConstrState(T%SD%z(Src), T%SD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SD_CopyOtherState(T%SD%OtherSt(Src), T%SD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! case (Module_SeaSt) -! case (Module_SrvD) + case (Module_SrvD) + + call SrvD_CopyContState(T%SrvD%x(Src), T%SrvD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyDiscState(T%SrvD%xd(Src), T%SrvD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyConstrState(T%SrvD%z(Src), T%SrvD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call SrvD_CopyOtherState(T%SrvD%OtherSt(Src), T%SrvD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + case default call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) return @@ -1144,4 +929,334 @@ logical function Failed() end function end subroutine +subroutine FAST_MapOutputs(Mod, Maps, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_TransferOutputs' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + integer(IntKi) :: DstIns, SrcIns + + ! Loop through mappings that use this module's outputs + do i = 1, size(Maps) + + ! If map doesn't apply to this module, cycle + if (Mod%Idx /= Maps(i)%SrcModIdx) cycle + + ! Get source and destination module instances + SrcIns = Maps(i)%SrcIns + DstIns = Maps(i)%DstIns + + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Maps(i)%Key) + + case ('ED BladeRoot -> BD RootMotion') + + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(DstIns), Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + ! + + case ('BD ReactionForce -> ED HubLoad') + + ! u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations + call Transfer_Point_to_Point(T%BD%y(SrcIns)%ReactionForce, Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, SrcIns)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return + ! u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force + ! u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + + ! Set flag indicating that mapping has been updated + Maps(i)%Updated = .true. + + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mod !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + integer(IntKi), intent(in) :: Dst + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: DstIns, SrcIns + type(ED_InputType), pointer :: u_ED + type(BD_InputType), pointer :: u_BD + logical :: ED_ResetHubPtLoad + + ErrStat = ErrID_None + ErrMsg = '' + + ! Check that Dst is valid + if (Dst /= 1 .and. Dst /= 2) then + call SetErrStat(ErrID_Fatal, "Dst must be 1 or 2, given "//trim(Num2LStr(Dst)), ErrStat, ErrMsg, RoutineName) + return + end if + + select case (Mod%ID) + + case (Module_AD) + + case (Module_BD) + + select case (Dst) + case (1) + u_BD => T%BD%Input(1, Mod%Ins) + case (2) + u_BD => T%BD%u(Mod%Ins) + end select + + ! u_BD%DistrLoad%Force = 0.0_ReKi + ! u_BD%DistrLoad%Moment = 0.0_ReKi + + ! u_BD%PointLoad%Force = 0.0_ReKi + ! u_BD%PointLoad%Moment = 0.0_ReKi + + case (Module_ED) + + select case (Dst) + case (1) + u_ED => T%ED%Input(1) + case (2) + u_ED => T%ED%u + end select + + ED_ResetHubPtLoad = .true. + + ! u_ED%NacelleLoads%Force = 0.0_ReKi + ! u_ED%NacelleLoads%Moment = 0.0_ReKi + + ! u_ED%TowerPtLoads%Force = 0.0_ReKi + ! u_ED%TowerPtLoads%Moment = 0.0_ReKi + + ! u_ED%TwrAddedMass = 0.0_ReKi + ! u_ED%PtfmAddedMass = 0.0_ReKi + + case (Module_IfW) + + case (Module_SrvD) + + end select + + ! Loop through mappings that set this module's inputs + do i = 1, size(Maps) + + ! If mapping hasn't been updated, cycle + if (.not. Maps(i)%Updated) cycle + + ! If map doesn't apply to this module, cycle + if (Mod%Idx /= Maps(i)%DstModIdx) cycle + + ! Get source and destination module instances + SrcIns = Maps(i)%SrcIns + DstIns = Maps(i)%DstIns + + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Maps(i)%Key) + + case ('ED BladeRoot -> BD RootMotion') + + call MeshCopy(Maps(i)%MeshTmp, u_BD%RootMotion, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + + case ('BD ReactionForce -> ED HubLoad') + + if (ED_ResetHubPtLoad) then + u_ED%HubPtLoad%Force = 0.0_ReKi + u_ED%HubPtLoad%Moment = 0.0_ReKi + ED_ResetHubPtLoad = .false. + end if + + u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force + u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMsg, dUdu, dUdy) + type(ModDataType), intent(in) :: ModData(:) !< Module data + integer(IntKi), intent(in) :: ModOrder(:) + type(TC_MappingType), intent(inout) :: Mappings(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), optional, intent(inout) :: dUdu(:, :), dUdy(:, :) + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: j, k + integer(IntKi) :: iiu, iiy + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mapping array + do j = 1, size(Mappings) + + ! If mapping input and output modules are not in module order array, cycle + if (all(Mappings(j)%DstModIdx /= ModOrder) .and. all(Mappings(j)%SrcModIdx /= ModOrder)) cycle + + ! Get input/output module instances + iiu = Mappings(j)%DstIns + iiy = Mappings(j)%SrcIns + + ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) + select case (Mappings(j)%Key) + + case ('ED BladeRoot -> BD RootMotion') + call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(iiu), T%BD%Input(1, iiu)%RootMotion, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + + case ('BD ReactionForce -> ED HubLoad') + call Linearize_Point_to_Point(T%BD%y(iiy)%ReactionForce, T%ED%u%HubPtLoad, Mappings(j)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, iiy)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return ! <- displaced positions for load calculations + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Mappings(j)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + + if (present(dUdu)) then + call dUduSetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) + end if + if (present(dUdy)) then + call dUdySetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) + end if + + end do + +contains + subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) + type(TC_MappingType), intent(inout) :: M !< Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data + type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data + + ! Effect of input Translation Velocity on input Translation Displacement + if (allocated(MML%tv_uD)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%tv_uD, dUdu) + end if + + ! Effect of input Translation Acceleration on input Translation Displacement + if (allocated(MML%ta_uD)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, -MML%ta_uD, dUdu) + end if + + ! Effect of input Moments on input Translation Displacement + if (allocated(MML%M_uS)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%u([M%SrcDispVarIdx]), VF_TransDisp, -MML%M_uS, dUdu) + end if + end subroutine + + subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) + type(TC_MappingType), intent(inout) :: M !< Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data + type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data + + ! Load identity + if (allocated(MML%li)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Force, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%li, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Moment, -MML%li, dUdy) + end if + + ! Moment to Force + if (allocated(MML%m_f)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%m_f, dUdy) + end if + + ! Moment to output translation displacement + if (allocated(Mappings(j)%MeshMap%dM%m_uD)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) + end if + + ! Motion identity + if (allocated(MML%mi)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Orientation, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransVel, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransAcc, -MML%mi, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_AngularAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%mi, dUdy) + end if + + ! Translation to Rotation + if (allocated(MML%fx_p)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransDisp, SrcMod%Vars%y(M%SrcVarIdx), VF_Orientation, -MML%fx_p, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%fx_p, dUdy) + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularAcc, -MML%fx_p, dUdy) + end if + + ! Translation velocity to translation displacement + if (allocated(MML%tv_us)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransVel, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%tv_us, dUdy) + end if + + ! Translation acceleration to translation displacement + if (allocated(MML%ta_us)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_TransDisp, -MML%ta_us, dUdy) + end if + + ! Translation acceleration to angular velocity + if (allocated(MML%ta_rv)) then + call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_TransAcc, SrcMod%Vars%y(M%SrcVarIdx), VF_AngularVel, -MML%ta_us, dUdy) + end if + end subroutine + + subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) + type(ModVarType), intent(in) :: RowVars(:), ColVars(:) + integer(IntKi), intent(in) :: RowField, ColField + real(R8Ki), intent(in) :: Loc(:, :) + real(R8Ki), intent(inout) :: Gbl(:, :) + integer(IntKi) :: ir, ic, m, n, mSize, nSize + m = 1 + do ir = 1, size(RowVars) + if (RowVars(ir)%Field /= RowField) cycle + n = 1 + mSize = RowVars(ir)%Size + do ic = 1, size(ColVars) + if (ColVars(ic)%Field /= ColField) cycle + nSize = ColVars(ic)%Size + Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) = Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) + & + Loc(m:m + mSize - 1, n:n + nSize - 1) + ! write (*, *) 'Rows = ', RowVars(ir)%iGblSol + ! write (*, *) 'Cols = ', ColVars(ic)%iGblSol + ! write (*, *) 'Shape = ', mSize, nSize + ! write (*, '(A,*(ES14.5))') 'Values = ', Loc(m:m + mSize - 1, n:n + nSize - 1) + n = n + nSize + end do + m = m + mSize + end do + end subroutine + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + end module From 487d72a6e5556e1b3b6eb1530f7c3f4ba3a23fa9 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 28 Aug 2023 14:55:30 +0000 Subject: [PATCH 19/61] Fix BD state displacement calc --- modules/openfast-library/src/Solver.f90 | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 6c85a3a5e4..32ba7a6d02 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -852,15 +852,10 @@ subroutine UpdateBeamDynGlobalReference(p, m, Mod, T, ErrStat, ErrMsg) temp_id = (i - 1)*(p_BD%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. temp_id2 = (i - 1)*p_BD%nodes_per_elem + j ! Index to a node within element i - if (temp_id == 1) cycle - - x_BD%q(1:3, temp_id) = GlbPos_old + matmul(GlbRot_old, p_BD%uuN0(1:3, j, i) + x_BD%q(1:3, temp_id)) - & - GlbPos_new - matmul(GlbRot_new, p_BD%uuN0(1:3, j, i)) - - ! Get the absolute position of the node - ! x_BD%q(1:3, temp_id) = matmul(GlbRot_new, (matmul(transpose(GlbRot_old), p_BD%uuN0(1:3, j, i)) - & - ! matmul(transpose(GlbRot_new), p_BD%uuN0(1:3, j, i)))) + & - ! matmul(transpose(GlbRot_diff), x_BD%q(1:3, temp_id)) + ! Calculate displacements from new reference + x_BD%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & + GlbPos_old + matmul(GlbRot_old, p_BD%uuN0(1:3, j, i) + x_BD%q(1:3, temp_id)) - & + GlbPos_new - matmul(GlbRot_new, p_BD%uuN0(1:3, j, i))) ! Update the node orientation rotation of the node x_BD%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x_BD%q(4:6, temp_id)) From 8c96eaad920da0746320136d5fa8ee17978fad32 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 29 Aug 2023 12:38:24 +0000 Subject: [PATCH 20/61] Partially working --- modules/beamdyn/src/BeamDyn.f90 | 2 +- modules/beamdyn/src/BeamDyn_Subs.f90 | 32 +++---- modules/openfast-library/src/Solver.f90 | 119 ++++++++++++------------ 3 files changed, 72 insertions(+), 81 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 330e824fea..a31490d747 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -276,7 +276,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I end if - CALL Set_BldMotion_NoAcc(p, x, MiscVar, y) + CALL Set_BldMotion_NoAcc(p, u, x, MiscVar, y) IF(QuasiStaticInitialized) THEN ! Set the BldMotion mesh acceleration but only if quasistatic succeeded diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index 234efb4a62..c3cac9724e 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -623,9 +623,10 @@ END SUBROUTINE BD_TrapezoidalPointWeight !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates y%BldMotion%TranslationDisp, y%BldMotion%Orientation, y%BldMotion%TranslationVel, and !! y%BldMotion%RotationVel, which depend only on states (and indirectly, u%RootMotion), and parameters. -SUBROUTINE Set_BldMotion_NoAcc(p, x, m, y) +SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t - in the FAST coordinate system (NOT BD) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_MiscVarType), INTENT(IN ) :: m !< misc/optimization variables TYPE(BD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- @@ -683,6 +684,9 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, m, y) ENDDO CASE (BD_MESH_QP) + + y%BldMotion%TranslationVel(:,1) = u%RootMotion%TranslationVel(:,1) + y%BldMotion%RotationVel(:,1) = u%RootMotion%RotationVel(:,1) DO i=1,p%elem_total DO j=1,p%nqp @@ -690,39 +694,31 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, m, y) ! Calculate the translational displacement of each quadrature node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - ! y%BldMotion%TranslationDisp(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%uuu(1:3,j,i) ) - y%BldMotion%TranslationDisp(1:3,temp_id2) = p%GlbPos + matmul(p%GlbRot, p%uu0(1:3, j, i) + m%qp%uuu(1:3,j,i)) - & - y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uu0(1:3, j, i)) - + y%BldMotion%TranslationDisp(1:3,temp_id2) = p%GlbPos + MATMUL(p%GlbRot, p%uu0(1:3,j,i) + m%qp%uuu(1:3,j,i)) - y%BldMotion%Position(1:3,temp_id2) !bjj: note differences here compared to BDrot_to_FASTdcm !adp: in BDrot_to_FASTdcm we are assuming that x%q(4:6,:) is zero because there is no rotatinoal displacement yet ! Find the rotation parameter in global coordinates (initial orientation + rotation parameters) ! referenced against the DCM of the blade root at T=0. - CALL BD_CrvCompose( cc, m%qp%uuu(4:6,j,i), p%uu0(4:6,j,i), FLAG_R1R2 ) - CALL BD_CrvCompose( cc0, p%Glb_crv, cc, FLAG_R1R2 ) + temp_R = wm_to_dcm(wm_compose(p%Glb_crv, wm_compose(m%qp%uuu(4:6,j,i), p%uu0(4:6,j,i)))) - CALL BD_CrvMatrixR(cc0,temp_R) ! returns temp_R (the transpose of the DCM orientation matrix) - ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) - y%BldMotion%Orientation(1:3,1:3,temp_id2) = matmul(p%GlbRot, TRANSPOSE(temp_R)) + ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) + y%BldMotion%Orientation(1:3,1:3,temp_id2) = TRANSPOSE(temp_R) ! Calculate the translation velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationVel(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%vvv(1:3,j,i)) + y%BldMotion%TranslationVel(1:3,temp_id2) = MATMUL(p%GlbRot, m%qp%vvv(1:3,j,i)) ! Calculate the rotational velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. - y%BldMotion%RotationVel(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%vvv(4:6,j,i)) + y%BldMotion%RotationVel(1:3,temp_id2) = MATMUL(p%GlbRot, m%qp%vvv(4:6,j,i)) ENDDO ENDDO - - CASE (BD_MESH_STATIONS) END SELECT - END SUBROUTINE Set_BldMotion_NoAcc !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates values for the y%BldMotion mesh. @@ -744,7 +740,7 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) ! set positions and velocities (not accelerations) - call Set_BldMotion_NoAcc(p, x, m, y) + call Set_BldMotion_NoAcc(p, u, x, m, y) ! Only need this bit for dynamic cases IF ( p%analysis_type /= BD_STATIC_ANALYSIS ) THEN @@ -752,10 +748,6 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) ! now set the accelerations: ! The first node on the mesh is just the root location: - y%BldMotion%TranslationDisp(:,1) = u%RootMotion%TranslationDisp(:,1) - y%BldMotion%Orientation(:,:,1) = u%RootMotion%Orientation(:,:,1) - y%BldMotion%TranslationVel(:,1) = u%RootMotion%TranslationVel(:,1) - y%BldMotion%RotationVel(:,1) = u%RootMotion%RotationVel(:,1) y%BldMotion%TranslationAcc(:,1) = u%RootMotion%TranslationAcc(:,1) y%BldMotion%RotationAcc(:,1) = u%RootMotion%RotationAcc(:,1) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 32ba7a6d02..9144362ecc 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -391,7 +391,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Debug !---------------------------------------------------------------------------- - munit = -1 + ! munit = -1 call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return @@ -734,8 +734,8 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Transfer inputs and calculate outputs for all modules (use current state) do i = 1, size(p%iModAll) - call FAST_UpdateInputs(ModData(p%iModAll(i)), m%Mappings, 1, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputSolve(ModData(p%iModAll(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_CalcOutput(ModData(p%iModAll(i)), t_initial, STATE_CURR, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_MapOutputs(ModData(p%iModAll(i)), m%Mappings, & @@ -812,71 +812,66 @@ subroutine UpdateBeamDynGlobalReference(p, m, Mod, T, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) - real(R8Ki) :: GlbPos_old(3), GlbPos_new(3), GlbPos_diff(3) - real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) - integer(IntKi) :: i, j, temp_id, temp_id2 + real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) + integer(IntKi) :: i, j, k ErrStat = ErrID_None ErrMsg = '' - ! Save old global position, rotation, and WM - GlbPos_old = T%BD%p(Mod%Ins)%GlbPos - GlbRot_old = T%BD%p(Mod%Ins)%GlbRot - GlbWM_old = T%BD%p(Mod%Ins)%Glb_crv + associate (p_BD => T%BD%p(Mod%Ins), & + m_BD => T%BD%m(Mod%Ins), & + u_BD => T%BD%Input(1, Mod%Ins), & + x_BD => T%BD%x(Mod%Ins, STATE_PRED)) - ! Calculate new global position, rotation, and WM from root motion - GlbPos_new = T%BD%Input(1, Mod%Ins)%RootMotion%Position(:, 1) + & - T%BD%Input(1, Mod%Ins)%RootMotion%TranslationDisp(:, 1) - GlbRot_new = transpose(T%BD%Input(1, Mod%Ins)%RootMotion%Orientation(:, :, 1)) - GlbWM_new = wm_from_dcm(GlbRot_new) + ! Save old global position, rotation, and WM (AO) + GlbPos_old = p_BD%GlbPos + GlbRot_old = p_BD%GlbRot + GlbWM_old = p_BD%Glb_crv - ! Update the module global values - T%BD%p(Mod%Ins)%GlbPos = GlbPos_new - T%BD%p(Mod%Ins)%GlbRot = GlbRot_new - T%BD%p(Mod%Ins)%Glb_crv = GlbWM_new + ! Calculate new global position, rotation, and WM from root motion (BO) + GlbPos_new = u_BD%RootMotion%Position(:, 1) + & + u_BD%RootMotion%TranslationDisp(:, 1) + GlbRot_new = transpose(u_BD%RootMotion%Orientation(:, :, 1)) + GlbWM_new = wm_from_dcm(GlbRot_new) - ! Calculate differences between old and new reference - GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) - GlbWM_diff = wm_compose(wm_inv(GlbWM_old), GlbWM_new) - GlbPos_diff = GlbPos_old - GlbPos_new + ! Update the module global values + p_BD%GlbPos = GlbPos_new + p_BD%GlbRot = GlbRot_new + p_BD%Glb_crv = GlbWM_new - associate (x_BD => T%BD%x(Mod%Ins, STATE_PRED), p_BD => T%BD%p(Mod%Ins)) - - x_BD%q(:, 1) = 0.0_R8Ki - x_BD%dqdt(1:3, 1) = matmul(transpose(GlbRot_diff), T%BD%Input(1, Mod%Ins)%RootMotion%TranslationVel(:, 1)) - x_BD%dqdt(4:6, 1) = matmul(transpose(GlbRot_diff), T%BD%Input(1, Mod%Ins)%RootMotion%RotationVel(:, 1)) + ! Calculate differences between old and new reference (BA = BO*AO^T) + GlbRot_diff = matmul(GlbRot_new, transpose(GlbRot_old)) + GlbWM_diff = wm_inv(wm_compose(GlbWM_new, wm_inv(GlbWM_old))) do i = 1, p_BD%elem_total do j = 1, p_BD%nodes_per_elem - temp_id = (i - 1)*(p_BD%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. - temp_id2 = (i - 1)*p_BD%nodes_per_elem + j ! Index to a node within element i + ! State index + k = (i - 1)*(p_BD%nodes_per_elem - 1) + j ! Calculate displacements from new reference - x_BD%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & - GlbPos_old + matmul(GlbRot_old, p_BD%uuN0(1:3, j, i) + x_BD%q(1:3, temp_id)) - & - GlbPos_new - matmul(GlbRot_new, p_BD%uuN0(1:3, j, i))) + x_BD%q(1:3, k) = matmul(transpose(GlbRot_new), & + matmul(GlbRot_old, p_BD%uuN0(1:3, j, i) + x_BD%q(1:3, k)) - & + matmul(GlbRot_new, p_BD%uuN0(1:3, j, i))) ! Update the node orientation rotation of the node - x_BD%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x_BD%q(4:6, temp_id)) - - ! Update the translational velocity - x_BD%dqdt(1:3, temp_id) = matmul(transpose(GlbRot_diff), x_BD%dqdt(1:3, temp_id)) - - ! Update the rotational velocity - x_BD%dqdt(4:6, temp_id) = matmul(transpose(GlbRot_diff), x_BD%dqdt(4:6, temp_id)) + x_BD%q(4:6, k) = wm_compose(GlbWM_diff, x_BD%q(4:6, k)) + ! Update the translational and rotational velocities + x_BD%dqdt(1:3, k) = matmul(GlbRot_diff, x_BD%dqdt(1:3, k)) + x_BD%dqdt(4:6, k) = matmul(GlbRot_diff, x_BD%dqdt(4:6, k)) end do end do - end associate + ! Overwrite values at first node based on root motion + x_BD%q(:, 1) = 0.0_R8Ki + x_BD%dqdt(1:3, 1) = matmul(GlbRot_new, u_BD%RootMotion%TranslationVel(:, 1)) + x_BD%dqdt(4:6, 1) = matmul(GlbRot_new, u_BD%RootMotion%RotationVel(:, 1)) - ! T%BD%x(Mod%Ins, STATE_PRED)%q = 0 - ! T%BD%x(Mod%Ins, STATE_PRED)%dqdt = 0 + call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) + call XferLocToGbl1D(Mod%ixs, m_BD%Vals%x, m%xn) - call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) - call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%x, m%xn) - call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + end associate end subroutine @@ -985,8 +980,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Loop through Option 2 modules do i = 1, size(p%iModOpt2) - call FAST_UpdateInputs(Mods(p%iModOpt2(i)), m%Mappings, 1, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, & Turbine, ErrStat2, ErrMsg2, m%xn); if (Failed()) return call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & @@ -999,8 +994,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Get inputs and update states for Option 1 modules not in Option 2 do i = 1, size(p%iModOpt1US) - call FAST_UpdateInputs(Mods(p%iModOpt1US(i)), m%Mappings, 1, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -1037,19 +1032,19 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM write (m%DebugUnit, *) "iterConv = ", iterConv write (m%DebugUnit, '(A,*(ES16.7))') " BD1-eps = ", pack(Turbine%BD%m(1)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3,:,1) - Turbine%BD%m(1)%qp%RR0(1:3,3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-kappa = ", pack(Turbine%BD%m(1)%qp%kappa(1:3, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3, :, 1), .true.) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Nrrr = ", pack(Turbine%BD%m(1)%Nrrr(1:3, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3, :, 1), .true.) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%p(1)%Glb_crv - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1)) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1)) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1)) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%p(1)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1))) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1))) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1,1)%RootMotion%Orientation(:,:,1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1,2)%RootMotion%Orientation(:,:,1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1))) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1), .true.) !---------------------------------------------------------------------- ! Update Jacobian @@ -1081,8 +1076,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do i = 1, size(p%iModOpt1) call FAST_MapOutputs(Mods(p%iModOpt1(i)), m%Mappings, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_UpdateInputs(Mods(p%iModOpt1(i)), m%Mappings, 2, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, 2, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do call PackModuleInputs(Mods, p%iModOpt1, Turbine, u_tmp=m%u_tmp) @@ -1133,6 +1128,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM m%dq(:, COL_AA) = -p%C(1)*m%XB(p%iJX2, 1) ! Transfer change in q state matrix to change in x array + m%dx = 0.0_R8Ki call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) ! Add delta to x array to get new states (respect variable fields) @@ -1190,6 +1186,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end if end do + ! Populate state matrix with latest values from state array + call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(p%iModAll) call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return From 709cdff0d0af33e31e792cbf223136af517f95c8 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 28 Aug 2023 08:59:51 -0600 Subject: [PATCH 21/61] BD: change reference frame to rootmotion mesh The reference frame is now moving. All values from p%GlbRot, p%Glb_crv, and p%GlbPos are now stored as otherstates and get updated at the end of an updatestates routine. Additional logic and data handling was changed within BD: - UpdateStates starts with the initial root position at T, and `q` and `dqdt` are relative to this position/orientation. - once UpdateStates converges, the `q` and `dqdt` states are updated to the root position/orientat at T+dt - Output calculations (mesh and channel outputs) have been modified - Inputs are slightly modified as well During Init, the values in `q` and `dqdt` are updated twice. The first time is relative to the reference frame for the meshes, and the second time for the mesh reference frame + displacements. --- modules/beamdyn/src/BeamDyn.f90 | 365 +- modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 | 41 +- modules/beamdyn/src/BeamDyn_IO.f90 | 26 +- modules/beamdyn/src/BeamDyn_Subs.f90 | 59 +- modules/beamdyn/src/BeamDyn_Types.f90 | 2953 ++++++++++++++++- modules/beamdyn/src/Driver_Beam.f90 | 2 +- modules/beamdyn/src/Driver_Beam_Subs.f90 | 9 +- modules/beamdyn/src/Registry_BeamDyn.txt | 7 +- .../tests/test_BD_InputGlobalLocal.F90 | 10 +- .../tests/test_ExtractRelativeRotation.F90 | 4 +- modules/beamdyn/tests/test_tools.F90 | 9 +- 11 files changed, 3205 insertions(+), 280 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index a31490d747..1d648aa935 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -109,48 +109,25 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I CALL DispNVD( BeamDyn_Ver ) - CALL BD_ReadInput(InitInp%InputFile,InputFileData,InitInp%RootName,Interval,ErrStat2,ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + CALL BD_ReadInput(InitInp%InputFile,InputFileData,InitInp%RootName,Interval,ErrStat2,ErrMsg2); if (Failed()) return + CALL BD_ValidateInputData( InitInp, InputFileData, ErrStat2, ErrMsg2 ); if (Failed()) return - CALL BD_ValidateInputData( InitInp, InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + ! The reference frame is set by the root motion mesh initial position + call InitRefFrame( InitInp, OtherState, ErrStat2, ErrMsg2 ); if (Failed()) return ! this routine sets *some* of the parameters (basically the "easy" ones) - call SetParameters(InitInp, InputFileData, p, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + call SetParameters(InitInp, InputFileData, p, OtherState, ErrStat2, ErrMsg2); if (Failed()) return ! Temporary GLL point intrinsic coordinates array - CALL BD_GenerateGLL(p%nodes_per_elem,GLL_nodes,ErrStat2,ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + CALL BD_GenerateGLL(p%nodes_per_elem,GLL_nodes,ErrStat2,ErrMsg2); if (Failed()) return ! In the following, trapezoidalpointweight should be generalized to multi-element; likewise for gausspointweight IF(p%quadrature .EQ. GAUSS_QUADRATURE) THEN - CALL BD_GaussPointWeight(p%nqp,p%QPtN,p%QPtWeight,ErrStat2,ErrMsg2) !calculates p%QPtN and p%QPtWeight - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + CALL BD_GaussPointWeight(p%nqp,p%QPtN,p%QPtWeight,ErrStat2,ErrMsg2); if (Failed()) return !calculates p%QPtN and p%QPtWeight ELSEIF(p%quadrature .EQ. TRAP_QUADRATURE) THEN @@ -159,41 +136,22 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ENDIF ! compute physical distances to set positions of p%uuN0 (FE GLL_Nodes) (depends on p%SP_Coef): - call InitializeNodalLocations(InputFileData%member_total,InputFileData%kp_member,InputFileData%kp_coordinate,p,GLL_nodes,ErrStat2,ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + call InitializeNodalLocations(InputFileData%member_total,InputFileData%kp_member,InputFileData%kp_coordinate,p,GLL_nodes,ErrStat2,ErrMsg2); if (Failed()) return ! compute p%Shp, p%ShpDer, and p%Jacobian: CALL BD_InitShpDerJaco( GLL_Nodes, p ) ! set mass and stiffness matrices: p%Stif0_QP and p%Mass0_QP - call InitializeMassStiffnessMatrices(InputFileData, p, ErrStat2,ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + call InitializeMassStiffnessMatrices(InputFileData, p, ErrStat2,ErrMsg2); if (Failed()) return ! Set the initial displacements: p%uu0, p%E10 CALL BD_QuadraturePointDataAt0(p) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if -!FIXME: shift mass stiffness matrices here from the keypoint line to the calculated curvature line in p%uu0 -! CALL BD_KMshift2Ref(p) - - call Initialize_FEweights(p,GLL_nodes,ErrStat2,ErrMsg2) ! set p%FEweight; needs p%uuN0 and p%uu0 - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Initialize_FEweights(p,GLL_nodes,ErrStat2,ErrMsg2); if (Failed()) return ! set p%FEweight; needs p%uuN0 and p%uu0 ! compute blade mass, CG, and IN for summary file: - CALL BD_ComputeBladeMassNew( p, ErrStat2, ErrMsg2 ) !computes p%blade_mass,p%blade_CG,p%blade_IN - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_ComputeBladeMassNew( p, ErrStat2, ErrMsg2 ); if (Failed()) return !computes p%blade_mass,p%blade_CG,p%blade_IN ! Actuator @@ -209,41 +167,19 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ! Define and initialize system inputs (set up and initialize input meshes) here: - call Init_u(InitInp, p, u, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + call Init_u(InitInp, p, OtherState, u, ErrStat2, ErrMsg2); if (Failed()) return ! allocate and initialize continuous states (need to do this after initializing inputs): - call Init_ContinuousStates(p, u, x, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + call Init_ContinuousStates(p, u, x, OtherState, ErrStat2, ErrMsg2); if (Failed()) return ! allocate and initialize other states: - call Init_OtherStates(p, OtherState, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Init_OtherStates(u, p, OtherState, ErrStat2, ErrMsg2); if (Failed()) return ! initialize outputs (need to do this after initializing inputs and parameters (p%nnu0)) - call Init_y(p, u, y, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - + call Init_y(p, OtherSTate, u, y, ErrStat2, ErrMsg2); if (Failed()) return ! allocate and initialize misc vars (do this after initializing input and output meshes): - call Init_MiscVars(p, u, y, MiscVar, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + call Init_MiscVars(p, u, y, MiscVar, ErrStat2, ErrMsg2); if (Failed()) return ! Now that we have the initial conditions, we can run a quasi-steady-state solve @@ -253,8 +189,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ! This will set m%qp%aaa, OtherState%Acc, x%q, and x%dqdt ! (note that we won't ramp loads as there are no loads provided yet.) ! if this is not successful, it restores the values of x and sets OtherState%Acc=0 - CALL BD_QuasiStatic(u,p,x,OtherState,MiscVar,ErrStat2,ErrMsg2, RampLoad=.false.) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_QuasiStatic(u,p,x,OtherState,MiscVar,ErrStat2,ErrMsg2, RampLoad=.false.); if (Failed()) return QuasiStaticInitialized = ErrStat2 == ErrID_None ! We have now run the quasi-static initialization once, so don't run again. ELSE @@ -276,7 +211,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I end if - CALL Set_BldMotion_NoAcc(p, u, x, MiscVar, y) + CALL Set_BldMotion_NoAcc(p, u, x, OtherState, MiscVar, y) IF(QuasiStaticInitialized) THEN ! Set the BldMotion mesh acceleration but only if quasistatic succeeded @@ -289,16 +224,14 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I !................................. ! set initialization outputs - call SetInitOut(p, InitOut, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SetInitOut(p, InitOut, errStat2, errMsg2); if (Failed()) return !............................................... ! Print the summary file if requested: if (InputFileData%SumPrint) then - call BD_PrintSum( p, x, MiscVar, InitInp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call BD_PrintSum( p, x, OtherState, MiscVar, InitInp, ErrStat2, ErrMsg2 ); if (Failed()) return end if !............................................... @@ -323,10 +256,15 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I call Cleanup() CONTAINS - SUBROUTINE Cleanup() - if (allocated(GLL_nodes )) deallocate(GLL_nodes ) - CALL BD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2) - END SUBROUTINE Cleanup + SUBROUTINE Cleanup() + if (allocated(GLL_nodes )) deallocate(GLL_nodes ) + CALL BD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2) + END SUBROUTINE Cleanup + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed END SUBROUTINE BD_Init subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) @@ -1090,12 +1028,64 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end subroutine SetInitOut + +!----------------------------------------------------------------------------------------------------------------------------------- +!> Set the global rotation information -- stored in OtherStates +subroutine InitRefFrame( InitInp, OtherState, ErrStat, ErrMsg ) + type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(BD_OtherStateType), intent(inout) :: OtherState !< Global rotations are stored in otherstate + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'InitRefFrame' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Global position vector + OtherState%GlbPos = InitInp%GlbPos + + ! Global rotation tensor. What comes from the driver may not be a properly formed + ! DCM (may have roundoff), so recalculate it from the extracted WM parameters. + OtherState%GlbRot = TRANSPOSE(InitInp%GlbRot) ! matrix that now transfers from local to global (FAST's DCMs convert from global to local) + CALL BD_CrvExtractCrv(OtherState%GlbRot,OtherState%Glb_crv, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + CALL BD_CrvMatrixR(OtherState%Glb_crv,OtherState%GlbRot) ! ensure that the rotation matrix is a DCM in double precision (this should be the same as TRANSPOSE(InitInp%GlbRot)) +end subroutine InitRefFrame + +!----------------------------------------------------------------------------------------------------------------------------------- +!> Set the global rotation information -- stored in OtherStates +subroutine SetRefFrame( u, OtherState, ErrStat, ErrMsg ) + type(BD_InputType), intent(in ) :: u !< Inputs + type(BD_OtherStateType), intent(inout) :: OtherState !< Global rotations are stored in otherstate + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'SetRefFrame' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Calculate new global position, rotation, and WM from root motion. Note that this is similar to the InitRefFrame routine + OtherState%GlbPos = u%RootMotion%Position(:, 1) + & + u%RootMotion%TranslationDisp(:, 1) + OtherState%GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) + !OtherState%Glb_crv = wm_from_dcm(OtherState%GlbRot) + CALL BD_CrvExtractCrv(OtherState%GlbRot, OtherState%Glb_crv, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine SetRefFrame + !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine allocates and initializes most (not all) of the parameters used in BeamDyn. -subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) +subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(BD_InputFile), intent(inout) :: InputFileData !< data from the input file [we may need to shift the keypoint to match a MK matrix eta for trap multi-element] type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx + type(BD_OtherStateType), intent(in ) :: OtherState !< Global rotations are stored in otherstate integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1116,20 +1106,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ErrMsg = "" - ! Global position vector - p%GlbPos = InitInp%GlbPos - - - ! Global rotation tensor. What comes from the driver may not be a properly formed - ! DCM (may have roundoff), so recalculate it from the extracted WM parameters. - p%GlbRot = TRANSPOSE(InitInp%GlbRot) ! matrix that now transfers from local to global (FAST's DCMs convert from global to local) - CALL BD_CrvExtractCrv(p%GlbRot,p%Glb_crv, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - CALL BD_CrvMatrixR(p%Glb_crv,p%GlbRot) ! ensure that the rotation matrix is a DCM in double precision (this should be the same as TRANSPOSE(InitInp%GlbRot)) - ! Gravity vector - p%gravity = MATMUL(InitInp%gravity,p%GlbRot) + p%gravity = MATMUL(InitInp%gravity,OtherState%GlbRot) !.................... @@ -1383,9 +1361,10 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) end subroutine SetParameters !----------------------------------------------------------------------------------------------------------------------------------- !> this routine initializes the outputs, y, that are used in the BeamDyn interface for coupling in the FAST framework. -subroutine Init_y( p, u, y, ErrStat, ErrMsg) +subroutine Init_y( p, OtherState, u, y, ErrStat, ErrMsg) type(BD_ParameterType), intent(inout) :: p !< Parameters -- intent(out) only because it changes p%NdIndx + type(BD_OtherStateType), intent(in ) :: OtherState !< Global rotations are stored in otherstate type(BD_InputType), intent(inout) :: u !< Inputs type(BD_OutputType), intent(inout) :: y !< Outputs integer(IntKi), intent( out) :: ErrStat !< Error status of the operation @@ -1453,10 +1432,10 @@ subroutine Init_y( p, u, y, ErrStat, ErrMsg) temp_id = (j-1)*p%dof_node - Pos = p%GlbPos + MATMUL(p%GlbRot,p%uuN0(1:3,j,i)) + Pos = OtherState%GlbPos + MATMUL(OtherState%GlbRot,p%uuN0(1:3,j,i)) ! possible type conversions here: - DCM = BDrot_to_FASTdcm(p%uuN0(4:6,j,i),p) + DCM = BDrot_to_FASTdcm(p%uuN0(4:6,j,i),p,OtherState) ! set the reference position and orientation for each node. temp_id = (i-1)*p%nodes_per_elem+j @@ -1531,10 +1510,11 @@ subroutine Init_y( p, u, y, ErrStat, ErrMsg) end subroutine Init_y !----------------------------------------------------------------------------------------------------------------------------------- !> this routine initializes the inputs, u, that are used in the BeamDyn interface for coupling in the FAST framework. -subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) +subroutine Init_u( InitInp, p, OtherState, u, ErrStat, ErrMsg ) type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(BD_ParameterType), intent(in ) :: p !< Parameters + type(BD_OtherStateType), intent(in ) :: OtherState !< Global rotations are stored in otherstate type(BD_InputType), intent(inout) :: u !< Inputs integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1612,8 +1592,8 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) if (ErrStat>=AbortErrLev) return - DCM = TRANSPOSE(p%GlbRot) - Pos = p%GlbPos + DCM = TRANSPOSE(OtherState%GlbRot) + Pos = OtherState%GlbPos CALL MeshPositionNode ( Mesh = u%RootMotion & , INode = 1 & , Pos = Pos & @@ -1659,11 +1639,11 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) DO i=1,p%elem_total DO j=1,p%nodes_per_elem - POS = p%GlbPos(1:3) + MATMUL(p%GlbRot,p%uuN0(1:3,j,i)) + POS = OtherState%GlbPos(1:3) + MATMUL(OtherState%GlbRot,p%uuN0(1:3,j,i)) ! Note: Here we can use this subroutine to get the DCM. This is under the assumption ! that there is no rotational displacement yet, so x%q is zero - DCM = BDrot_to_FASTdcm(p%uuN0(4:6,j,i),p) + DCM = BDrot_to_FASTdcm(p%uuN0(4:6,j,i),p,OtherState) temp_id = (i-1)*(p%nodes_per_elem-1)+j CALL MeshPositionNode ( Mesh = u%PointLoad & @@ -1716,11 +1696,11 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) DO i=1,p%elem_total DO j=1,p%nqp !NOTE: if we add multi-element to trap, we will need to change this. temp_id = (i-1)*p%nqp + j + p%qp_indx_offset ! Index to a node within element i - Pos(1:3) = p%GlbPos(1:3) + MATMUL(p%GlbRot,p%uu0(1:3,j,i)) + Pos(1:3) = OtherState%GlbPos(1:3) + MATMUL(OtherState%GlbRot,p%uu0(1:3,j,i)) ! Note: Here we can use this subroutine to get the DCM. This is under the assumption ! that there is no rotational displacement yet, so m%qp%uuu is zero - DCM = BDrot_to_FASTdcm(p%uu0(4:6,j,i),p) + DCM = BDrot_to_FASTdcm(p%uu0(4:6,j,i),p,OtherState) CALL MeshPositionNode ( Mesh = u%DistrLoad & ,INode = temp_id & @@ -1735,8 +1715,8 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) ! For Gauss quadrature, an additional node is added to the end. IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN ! First node - Pos(1:3) = p%GlbPos(1:3) + MATMUL(p%GlbRot,p%uuN0(1:3,1,1)) - DCM = BDrot_to_FASTdcm(p%uuN0(4:6,1,1),p) + Pos(1:3) = OtherState%GlbPos(1:3) + MATMUL(OtherState%GlbRot,p%uuN0(1:3,1,1)) + DCM = BDrot_to_FASTdcm(p%uuN0(4:6,1,1),p,OtherState) CALL MeshPositionNode ( Mesh = u%DistrLoad & ,INode = 1 & ,Pos = Pos & @@ -1746,8 +1726,8 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Last node - Pos(1:3) = p%GlbPos(1:3) + MATMUL(p%GlbRot,p%uuN0(1:3,p%nodes_per_elem,p%elem_total)) - DCM = BDrot_to_FASTdcm(p%uuN0(4:6,p%nodes_per_elem,p%elem_total),p) + Pos(1:3) = OtherState%GlbPos(1:3) + MATMUL(OtherState%GlbRot,p%uuN0(1:3,p%nodes_per_elem,p%elem_total)) + DCM = BDrot_to_FASTdcm(p%uuN0(4:6,p%nodes_per_elem,p%elem_total),p,OtherState) CALL MeshPositionNode ( Mesh = u%DistrLoad & ,INode = NNodes & ,Pos = Pos & @@ -1965,9 +1945,10 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) end subroutine Init_MiscVars !----------------------------------------------------------------------------------------------------------------------------------- !> this subroutine initializes the other states. -subroutine Init_OtherStates( p, OtherState, ErrStat, ErrMsg ) +subroutine Init_OtherStates( u, p, OtherState, ErrStat, ErrMsg ) + type(BD_InputType), intent(in ) :: u !< inputs (need new root location) type(BD_ParameterType), intent(in ) :: p !< Parameters - type(BD_OtherStateType), intent(inout) :: OtherState !< Other states + type(BD_OtherStateType), intent(inout) :: OtherState !< Other states (inout since reference info from GlbRot is stored here) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1998,13 +1979,17 @@ subroutine Init_OtherStates( p, OtherState, ErrStat, ErrMsg ) ! BJJ: not sure this should be used in CalcOutput when we are calculating Jacobians (this will alter the operating point of the continuous state) OtherState%RunQuasiStaticInit = .FALSE. + ! set the global position information + call SetRefFrame(u,OtherState,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine Init_OtherStates !----------------------------------------------------------------------------------------------------------------------------------- !> this subroutine initializes the continuous states. -subroutine Init_ContinuousStates( p, u, x, ErrStat, ErrMsg ) +subroutine Init_ContinuousStates( p, u, x, OtherState, ErrStat, ErrMsg ) type(BD_ParameterType), intent(inout) :: p !< Parameters !sets the copy-of-state values type(BD_InputType), intent(inout) :: u !< Inputs !intent(out) because of mesh copy, otherwise not changed type(BD_ContinuousStateType), intent(inout) :: x !< Continuous states + type(BD_OtherStateType), intent(in ) :: OtherState !< Other states (contains refrence frame info) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -2039,11 +2024,11 @@ subroutine Init_ContinuousStates( p, u, x, ErrStat, ErrMsg ) end if ! convert to BeamDyn-internal system inputs, u_tmp: - CALL BD_InputGlobalLocal(p,u_tmp) + CALL BD_InputGlobalLocal(p,OtherState,u_tmp) ! initialize states, given parameters and initial inputs (in BD coordinates) - CALL BD_CalcIC_Position(u_tmp,p,x, ErrStat2, ErrMsg2) + CALL BD_CalcIC_Position(u_tmp,p,x,OtherState, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL BD_CalcIC_Velocity(u_tmp,p,x) CALL Cleanup() @@ -2137,11 +2122,76 @@ SUBROUTINE BD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat ErrMsg = "" IF(p%analysis_type /= BD_STATIC_ANALYSIS) THEN ! dynamic analysis - CALL BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + call SetRefFrame(u(1),OtherState,ErrStat,ErrMsg); if (ErrStat >= AbortErrLev) return + CALL BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + call UpdateBeamDynGlobalReference() ! reference follows the blade root motion mesh ELSE !IF(p%analysis_type == BD_STATIC_ANALYSIS) THEN - CALL BD_Static( t, u, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) + CALL BD_Static( t, u, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) ENDIF +contains + +subroutine UpdateBeamDynGlobalReference() + character(*), parameter :: RoutineName = 'UpdateBeamDynGlobalReference' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) + real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) + real(R8Ki) :: GlbPos_old(3), GlbPos_new(3), GlbPos_diff(3) + real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) + integer(IntKi) :: i, j, temp_id, temp_id2 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Save old global position, rotation, and WM + GlbPos_old = OtherState%GlbPos + GlbRot_old = OtherState%GlbRot + GlbWM_old = OtherState%Glb_crv + + ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) + call SetRefFrame(u(1),OtherState,ErrStat2,ErrMsg2) + GlbPos_new = OtherState%GlbPos + GlbRot_new = OtherState%GlbRot + GlbWM_new = OtherState%Glb_crv + + ! Calculate differences between old and new reference + GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) + !GlbWM_diff = wm_compose(wm_inv(GlbWM_old), GlbWM_new) + call BD_CrvCompose(GlbWM_diff, GlbWM_old, GlbWM_new, FLAG_R1TR2) + GlbPos_diff = GlbPos_old - GlbPos_new + + + ! Root node is always aligned with root motion mesh + x%q(:, 1) = 0.0_R8Ki + x%dqdt(1:3, 1) = matmul(transpose(GlbRot_diff), u(1)%RootMotion%TranslationVel(:, 1)) + x%dqdt(4:6, 1) = matmul(transpose(GlbRot_diff), u(1)%RootMotion%RotationVel(:, 1)) + + do i = 1, p%elem_total + do j = 1, p%nodes_per_elem + + temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. + temp_id2 = (i - 1)*p%nodes_per_elem + j ! Index to a node within element i + + ! Calculate displacement in terms of new root motion mesh position + x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & + GlbPos_old + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + GlbPos_new - matmul(GlbRot_new, p%uuN0(1:3, j, i))) + + ! Update the node orientation rotation of the node + !x%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x%q(4:6, temp_id)) + call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1TR2) + + ! Update the translational velocity + x%dqdt(1:3, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(1:3, temp_id)) + + ! Update the rotational velocity + x%dqdt(4:6, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(4:6, temp_id)) + + end do + end do +end subroutine + END SUBROUTINE BD_UpdateStates @@ -2234,14 +2284,14 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! convert to BD coordinates and apply boundary conditions - CALL BD_InputGlobalLocal(p,m%u) + CALL BD_InputGlobalLocal(p,OtherState,m%u) ! Copy over the DistrLoads CALL BD_DistrLoadCopy( p, m%u, m ) ! Incorporate boundary conditions (note that we are doing this because the first node isn't really a state. should fix x so we don't need a temp copy here.) x_tmp%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) - CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, x_tmp%q( 4:6,1), ErrStat2, ErrMsg2) + CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, x_tmp%q( 4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return x_tmp%dqdt(1:3,1) = m%u%RootMotion%TranslationVel(:,1) @@ -2269,14 +2319,16 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ENDIF ! Calculate internal forces and moments + CALL BD_InternalForceMoment( x_tmp, OtherState, p, m ) CALL BD_InternalForceMoment( x_tmp, p, m ) ! Transfer the FirstNodeReaction forces to the output ReactionForce - y%ReactionForce%Force(:,1) = MATMUL(p%GlbRot,m%FirstNodeReactionLclForceMoment(1:3)) - y%ReactionForce%Moment(:,1) = MATMUL(p%GlbRot,m%FirstNodeReactionLclForceMoment(4:6)) + y%ReactionForce%Force(:,1) = MATMUL(OtherState%GlbRot,m%FirstNodeReactionLclForceMoment(1:3)) + y%ReactionForce%Moment(:,1) = MATMUL(OtherState%GlbRot,m%FirstNodeReactionLclForceMoment(4:6)) ! set y%BldMotion fields: + CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, OtherState, m, y) CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, m, y) !------------------------------------------------------- @@ -2304,7 +2356,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi ! Now we need to populate the blade node outputs here - call Calc_WriteBldNdOutput( p, m, y, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call Calc_WriteBldNdOutput( p, OtherState, m, y, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF end if @@ -2361,7 +2413,7 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ! END Actuator ! convert to BD coordinates and apply boundary conditions - CALL BD_InputGlobalLocal(p,m%u) + CALL BD_InputGlobalLocal(p,OtherState,m%u) ! Copy over the DistrLoads CALL BD_DistrLoadCopy( p, m%u, m ) @@ -2371,6 +2423,10 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL BD_CopyContState(x, dxdt, MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! dxdt%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + ! CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, dxdt%q( 4:6,1), OtherState, ErrStat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! if (ErrStat >= AbortErrLev) return ! dxdt%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) ! CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, dxdt%q( 4:6,1), ErrStat2, ErrMsg2) ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3601,7 +3657,7 @@ SUBROUTINE BD_Static(t,u,utimes,p,x,OtherState,m,ErrStat,ErrMsg) ! Transform quantities from global frame to local (blade in BD coords) frame - CALL BD_InputGlobalLocal(p,u_interp) + CALL BD_InputGlobalLocal(p,OtherState,u_interp) ! Incorporate boundary conditions @@ -4071,7 +4127,7 @@ SUBROUTINE BD_QuasiStatic(u,p,x,OtherState,m,ErrStat,ErrMsg, RampLoad) ! Transform quantities from global frame to local (blade in BD coords) frame - CALL BD_InputGlobalLocal(p,u_temp) + CALL BD_InputGlobalLocal(p,OtherState,u_temp) ! Incorporate boundary conditions CALL BD_BoundaryGA2(x,p,u_temp,OtherState, ErrStat2, ErrMsg2) @@ -4401,9 +4457,10 @@ END SUBROUTINE BD_QuasiStaticElementMatrix ! nodes along beam axis for the static case. This is more involved than in the dynamic case because m%EFint is not calculated beforehand. ! Nodal forces = K u !FIXME: NOTE: if we go to multiple elements for trap quadrature, we will need to double check this routine. -SUBROUTINE BD_InternalForceMoment( x, p, m ) +SUBROUTINE BD_InternalForceMoment( x, OtherState, p, m ) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t (contains blade reference frame) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables @@ -4515,8 +4572,8 @@ SUBROUTINE BD_InternalForceMoment( x, p, m ) ! Rotate coords to global reference frame DO i=1,SIZE(m%BldInternalForceFE,DIM=2) - m%BldInternalForceFE(1:3,i) = MATMUL(p%GlbRot,m%BldInternalForceFE(1:3,i)) - m%BldInternalForceFE(4:6,i) = MATMUL(p%GlbRot,m%BldInternalForceFE(4:6,i)) + m%BldInternalForceFE(1:3,i) = MATMUL(OtherState%GlbRot,m%BldInternalForceFE(1:3,i)) + m%BldInternalForceFE(4:6,i) = MATMUL(OtherState%GlbRot,m%BldInternalForceFE(4:6,i)) ENDDO @@ -4629,7 +4686,7 @@ SUBROUTINE BD_GA2(t,n,u,utimes,p,x,xd,z,OtherState,m,ErrStat,ErrMsg) !................ ! Transform quantities from global frame to local (blade) frame - CALL BD_InputGlobalLocal(p,u_interp) + CALL BD_InputGlobalLocal(p,OtherState,u_interp) ! Copy over the DistrLoads CALL BD_DistrLoadCopy( p, u_interp, m ) @@ -4691,7 +4748,7 @@ SUBROUTINE BD_GA2(t,n,u,utimes,p,x,xd,z,OtherState,m,ErrStat,ErrMsg) ENDIF ! Transform quantities from global frame to local (blade in BD coords) frame - CALL BD_InputGlobalLocal(p,u_interp) + CALL BD_InputGlobalLocal(p,OtherState,u_interp) ! Copy over the DistrLoads CALL BD_DistrLoadCopy( p, u_interp, m ) @@ -4824,7 +4881,7 @@ SUBROUTINE BD_BoundaryGA2(x,p,u,OtherState, ErrStat, ErrMsg) x%q(1:3,1) = u%RootMotion%TranslationDisp(1:3,1) ! Root rotations - CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1),p, x%q(4:6,1), ErrStat2, ErrMsg2) + CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1), p, OtherState, x%q(4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -5356,32 +5413,33 @@ END SUBROUTINE BD_CompTngtStiff !! 4 Point forces/moments !! 5 Distributed forces/moments !! It also transforms the DCM to rotation tensor in the input data structure -SUBROUTINE BD_InputGlobalLocal(p, u) +SUBROUTINE BD_InputGlobalLocal(p, OtherState, u) TYPE(BD_ParameterType), INTENT(IN ):: p + TYPE(BD_OtherStateType),INTENT(IN ):: OtherState !< Other states at t on input; at t+dt on outputs TYPE(BD_InputType), INTENT(INOUT):: u INTEGER(IntKi) :: i !< Generic counter CHARACTER(*), PARAMETER :: RoutineName = 'BD_InputGlobalLocal' ! Transform Root Motion from Global to Local (Blade) frame - u%RootMotion%TranslationDisp(:,1) = MATMUL(u%RootMotion%TranslationDisp(:,1),p%GlbRot) - u%RootMotion%TranslationVel(:,1) = MATMUL(u%RootMotion%TranslationVel( :,1),p%GlbRot) - u%RootMotion%RotationVel(:,1) = MATMUL(u%RootMotion%RotationVel( :,1),p%GlbRot) - u%RootMotion%TranslationAcc(:,1) = MATMUL(u%RootMotion%TranslationAcc( :,1),p%GlbRot) - u%RootMotion%RotationAcc(:,1) = MATMUL(u%RootMotion%RotationAcc( :,1),p%GlbRot) + u%RootMotion%TranslationDisp(:,1) = MATMUL(u%RootMotion%TranslationDisp(:,1),OtherState%GlbRot) + u%RootMotion%TranslationVel(:,1) = MATMUL(u%RootMotion%TranslationVel( :,1),OtherState%GlbRot) + u%RootMotion%RotationVel(:,1) = MATMUL(u%RootMotion%RotationVel( :,1),OtherState%GlbRot) + u%RootMotion%TranslationAcc(:,1) = MATMUL(u%RootMotion%TranslationAcc( :,1),OtherState%GlbRot) + u%RootMotion%RotationAcc(:,1) = MATMUL(u%RootMotion%RotationAcc( :,1),OtherState%GlbRot) ! Transform DCM to Rotation Tensor (RT) u%RootMotion%Orientation(:,:,1) = TRANSPOSE(u%RootMotion%Orientation(:,:,1)) ! matrix that now transfers from local to global (FAST's DCMs convert from global to local) ! Transform Applied Forces from Global to Local (Blade) frame DO i=1,p%node_total - u%PointLoad%Force(1:3,i) = MATMUL(u%PointLoad%Force(:,i),p%GlbRot) - u%PointLoad%Moment(1:3,i) = MATMUL(u%PointLoad%Moment(:,i),p%GlbRot) + u%PointLoad%Force(1:3,i) = MATMUL(u%PointLoad%Force(:,i),OtherState%GlbRot) + u%PointLoad%Moment(1:3,i) = MATMUL(u%PointLoad%Moment(:,i),OtherState%GlbRot) ENDDO ! transform distributed forces and moments DO i=1,u%DistrLoad%Nnodes - u%DistrLoad%Force(1:3,i) = MATMUL(u%DistrLoad%Force(:,i),p%GlbRot) - u%DistrLoad%Moment(1:3,i) = MATMUL(u%DistrLoad%Moment(:,i),p%GlbRot) + u%DistrLoad%Force(1:3,i) = MATMUL(u%DistrLoad%Force(:,i),OtherState%GlbRot) + u%DistrLoad%Moment(1:3,i) = MATMUL(u%DistrLoad%Moment(:,i),OtherState%GlbRot) ENDDO END SUBROUTINE BD_InputGlobalLocal @@ -5435,11 +5493,12 @@ END SUBROUTINE BD_DistrLoadCopy !! The initial displacements/rotations and linear velocities are !! set to the root value; the angular velocities over the beam !! are computed based on rigid body rotation: \omega = v_{root} \times r_{pos} -SUBROUTINE BD_CalcIC_Position( u, p, x, ErrStat, ErrMsg) +SUBROUTINE BD_CalcIC_Position( u, p, x, OtherState, ErrStat, ErrMsg) TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t (in BD coordinates) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states (contains reference frame info) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -5460,7 +5519,7 @@ SUBROUTINE BD_CalcIC_Position( u, p, x, ErrStat, ErrMsg) ! Since RootMotion%Orientation is the transpose of the absolute orientation in the global frame, ! we need to find the relative change in orientation from the reference. - CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1),p,temp_rv, ErrStat2, ErrMsg2) + CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1), p, OtherState, temp_rv, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -5472,7 +5531,7 @@ SUBROUTINE BD_CalcIC_Position( u, p, x, ErrStat, ErrMsg) DO j=k,p%nodes_per_elem ! reference at current root orientation. temp_p0 = MATMUL(u%rootmotion%orientation(:,:,1),p%uuN0(1:3,j,i)) ! Global frame - temp_p0 = MATMUL(temp_p0, p%GlbRot ) ! Into the local frame + temp_p0 = MATMUL(temp_p0, OtherState%GlbRot ) ! Into the local frame ! Add the root displacement (in local frame) to the reference at current root orientation in local frame, ! and subtract the reference to get the displacement. This is equivalent to TranslationDisp in the local frame. x%q(1:3,temp_id+j) = u%RootMotion%TranslationDisp(1:3,1) + temp_p0 - p%uuN0(1:3,j,i) diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 index 7cc98b7a03..34b9d85cda 100644 --- a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -275,8 +275,9 @@ END SUBROUTINE BldNdOuts_InitOut !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated !! fastest). If this iteration order is changed, it should be changed in the Calc_WriteBldNdOutput routine as well. -SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteBldNdOutput( p, OtherState, m, y, ErrStat, ErrMsg ) TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState ! Other states at time t TYPE(BD_MiscVarType), INTENT(INOUT) :: m ! misc variables TYPE(BD_OutputType), INTENT(INOUT) :: y ! outputs INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code @@ -858,7 +859,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) y%WriteOutput( IdxOutList ) = temp_vec(compIndx) ENDDO CASE (BldNd_MFbxl,BldNd_MFbyl,BldNd_MFbzl) @@ -866,7 +867,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFbxl) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -882,7 +883,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFcxl) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -897,7 +898,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFcxl) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -913,7 +914,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFdxl) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -928,7 +929,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFdxl) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -944,7 +945,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFgxl) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -959,7 +960,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fg(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFgxl) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -979,7 +980,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFbxr) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -994,7 +995,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFbxr) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1010,7 +1011,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFcxr) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1025,7 +1026,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFcxr) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1041,7 +1042,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFdxr) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1056,7 +1057,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFdxr) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1072,7 +1073,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFgxr) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1106,7 +1107,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFixl) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1121,7 +1122,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(OtherState%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFixl) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1139,7 +1140,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_FFixr) ! Gyroscopic force Fc x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) @@ -1154,7 +1155,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output nelem = p%OutNd2NdElem(2,idx_node) idx_node_in_elem = p%OutNd2NdElem(1,idx_node) - temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(OtherState%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output CASE (BldNd_MFixr) ! Gyroscopic moment Fc about x, root frame y%WriteOutput( IdxOutList ) = temp_vec(1) diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index fbc0be180a..0f242f6e2e 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -1911,11 +1911,12 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput END SUBROUTINE Calc_WriteOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine generates the summary file, which contains a regurgitation of the input data and interpolated flexible body data. -SUBROUTINE BD_PrintSum( p, x, m, InitInp, ErrStat, ErrMsg ) +SUBROUTINE BD_PrintSum( p, x, OtherState, m, InitInp, ErrStat, ErrMsg ) use YAML, only: yaml_write_var, yaml_write_array, yaml_write_list ! passed variables TYPE(BD_ParameterType), INTENT(IN) :: p !< Parameters of the structural dynamics module type(BD_ContinuousStateType), intent(in) :: x !< Continuous states + TYPE(BD_OtherStateType), intent(in ) :: OtherState !< Other states at t TYPE(BD_MiscVarType), INTENT(INout) :: m !< misc/optimization variables TYPE(BD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine INTEGER(IntKi), INTENT(OUT) :: ErrStat !< error status @@ -1943,15 +1944,15 @@ SUBROUTINE BD_PrintSum( p, x, m, InitInp, ErrStat, ErrMsg ) WRITE (UnSu,'(A)') '#This summary information was generated by '//TRIM( GetNVD(BeamDyn_Ver) ) WRITE (UnSu,'(/,A)') '# --- Main parameters' - call yaml_write_var (UnSu, 'Mass' , p%blade_mass , 'F13.3', ErrStat, ErrMsg, comment='(kg)') - call yaml_write_var (UnSu, 'Length' , p%blade_length , 'F13.3', ErrStat, ErrMsg, comment='(m)') - call yaml_write_list (UnSu, 'CG' , p%blade_CG , 'ES18.5', ErrStat, ErrMsg, comment='Blade center of mass (IEC coords) (m) from blade root') - call yaml_write_array(UnSu, 'JRoot' , p%blade_IN , 'ES18.5', ErrStat, ErrMsg, comment='Blade mass moment of inertia at blade root. NOTE: from mass distribution only, missing some important inertial contributions (see PR#1337)') - call yaml_write_list (UnSu, 'GlbPos' , p%GlbPos , 'ES18.5', ErrStat, ErrMsg, comment='Global position vector (IEC coords) of blade root') - call yaml_write_array(UnSu, 'GlbRot' , p%GlbRot , 'ES18.5', ErrStat, ErrMsg, comment='Global rotation tensor (IEC coords)') - call yaml_write_array(UnSu, 'RootOri' , InitInp%RootOri , 'ES18.5', ErrStat, ErrMsg, comment='Initial blade orientation tensor (relative to global rotation tensor)') - call yaml_write_list (UnSu, 'GlbCrv' , p%Glb_crv , 'ES18.5', ErrStat, ErrMsg, comment='Global rotation WM parameters (IEC coords)') - call yaml_write_list (UnSu, 'Gravity' , p%gravity , 'ES18.5', ErrStat, ErrMsg, comment='Gravity vector (m/s^2) (IEC coords)') + call yaml_write_var (UnSu, 'Mass' , p%blade_mass , 'F13.3', ErrStat, ErrMsg, comment='(kg)') + call yaml_write_var (UnSu, 'Length' , p%blade_length , 'F13.3', ErrStat, ErrMsg, comment='(m)') + call yaml_write_list (UnSu, 'CG' , p%blade_CG , 'ES18.5', ErrStat, ErrMsg, comment='Blade center of mass (IEC coords) (m) from blade root') + call yaml_write_array(UnSu, 'JRoot' , p%blade_IN , 'ES18.5', ErrStat, ErrMsg, comment='Blade mass moment of inertia at blade root. NOTE: from mass distribution only, missing some important inertial contributions (see PR#1337)') + call yaml_write_list (UnSu, 'GlbPos' , OtherState%GlbPos , 'ES18.5', ErrStat, ErrMsg, comment='Global position vector (IEC coords) of blade root at Initialization') + call yaml_write_array(UnSu, 'GlbRot' , OtherState%GlbRot , 'ES18.5', ErrStat, ErrMsg, comment='Global rotation tensor (IEC coords) at Initialization') + call yaml_write_array(UnSu, 'RootOri' , InitInp%RootOri , 'ES18.5', ErrStat, ErrMsg, comment='Initial blade orientation tensor (relative to global rotation tensor)') + call yaml_write_list (UnSu, 'GlbCrv' , OtherState%Glb_crv, 'ES18.5', ErrStat, ErrMsg, comment='Global rotation WM parameters (IEC coords) at Initialization') + call yaml_write_list (UnSu, 'Gravity' , p%gravity , 'ES18.5', ErrStat, ErrMsg, comment='Gravity vector (m/s^2) (IEC coords)') !FIXME:analysis_type IF(p%analysis_type .EQ. BD_STATIC_ANALYSIS) THEN @@ -2525,11 +2526,12 @@ END SUBROUTINE Compute_dX !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. !! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE Compute_RelState_Matrix(p, u, x, RelState_x, RelState_xdot) +SUBROUTINE Compute_RelState_Matrix(p, u, x, OtherState, RelState_x, RelState_xdot) TYPE(BD_ParameterType) , INTENT(IN ) :: p !< parameters TYPE(BD_InputType) , INTENT(IN ) :: u !< BD inputs TYPE(BD_ContinuousStateType) , INTENT(IN ) :: x !< BD continuous states + TYPE(BD_OtherStateType) , INTENT(IN ) :: OtherState !< Other states at t REAL(R8Ki) , INTENT(INOUT) :: RelState_x(:,:) !< REAL(R8Ki) , INTENT(INOUT) :: RelState_xdot(:,:) !< @@ -2560,7 +2562,7 @@ SUBROUTINE Compute_RelState_Matrix(p, u, x, RelState_x, RelState_xdot) dqdt_index = p%Jac_nx + q_index DisplacedPosition = u%RootMotion%Position(:,1) + u%RootMotion%TranslationDisp(:,1) & - - p%GlbPos - MATMUL(p%GlbRot, p%uuN0(1:3,j,i) + x%q(1:3,node) ) + - OtherState%GlbPos - MATMUL(OtherState%GlbRot, p%uuN0(1:3,j,i) + x%q(1:3,node) ) RotVel = real(u%RootMotion%RotationVel(:,1),R8Ki) RotAcc = real(u%RootMotion%RotationAcc(:,1),R8Ki) diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index c3cac9724e..77e53c3fb2 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -623,11 +623,12 @@ END SUBROUTINE BD_TrapezoidalPointWeight !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates y%BldMotion%TranslationDisp, y%BldMotion%Orientation, y%BldMotion%TranslationVel, and !! y%BldMotion%RotationVel, which depend only on states (and indirectly, u%RootMotion), and parameters. -SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) +SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t - in the FAST coordinate system (NOT BD) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(BD_MiscVarType), INTENT(IN ) :: m !< misc/optimization variables TYPE(BD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) @@ -656,7 +657,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) ! Calculate the translational displacement of each GLL node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationDisp(1:3,temp_id2) = p%GlbPos + matmul(p%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos + matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uuN0(1:3, j, i)) !bjj: note differences here compared to BDrot_to_FASTdcm @@ -664,7 +665,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) ! Find the rotation parameter in global coordinates (initial orientation + rotation parameters) ! referenced against the DCM of the blade root at T=0. CALL BD_CrvCompose( cc, x%q(4:6,temp_id), p%uuN0(4:6,j,i), FLAG_R1R2 ) - CALL BD_CrvCompose( cc0, p%Glb_crv, cc, FLAG_R1R2 ) + CALL BD_CrvCompose( cc0, OtherState%Glb_crv, cc, FLAG_R1R2 ) ! Create the DCM from the rotation parameters CALL BD_CrvMatrixR(cc0,temp_R) ! returns temp_R (the transpose of the DCM orientation matrix) @@ -674,11 +675,11 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) ! Calculate the translation velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationVel(1:3,temp_id2) = MATMUL(p%GlbRot,x%dqdt(1:3,temp_id)) + y%BldMotion%TranslationVel(1:3,temp_id2) = MATMUL(OtherState%GlbRot,x%dqdt(1:3,temp_id)) ! Calculate the rotational velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. - y%BldMotion%RotationVel(1:3,temp_id2) = MATMUL(p%GlbRot,x%dqdt(4:6,temp_id)) + y%BldMotion%RotationVel(1:3,temp_id2) = MATMUL(OtherState%GlbRot,x%dqdt(4:6,temp_id)) ENDDO ENDDO @@ -694,24 +695,27 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) ! Calculate the translational displacement of each quadrature node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationDisp(1:3,temp_id2) = p%GlbPos + MATMUL(p%GlbRot, p%uu0(1:3,j,i) + m%qp%uuu(1:3,j,i)) - y%BldMotion%Position(1:3,temp_id2) + y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos + matmul(OtherState%GlbRot, p%uu0(1:3, j, i) + m%qp%uuu(1:3,j,i)) - & + y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uu0(1:3, j, i)) + !bjj: note differences here compared to BDrot_to_FASTdcm !adp: in BDrot_to_FASTdcm we are assuming that x%q(4:6,:) is zero because there is no rotatinoal displacement yet ! Find the rotation parameter in global coordinates (initial orientation + rotation parameters) ! referenced against the DCM of the blade root at T=0. - temp_R = wm_to_dcm(wm_compose(p%Glb_crv, wm_compose(m%qp%uuu(4:6,j,i), p%uu0(4:6,j,i)))) + CALL BD_CrvCompose( cc, m%qp%uuu(4:6,j,i), p%uu0(4:6,j,i), FLAG_R1R2 ) + CALL BD_CrvCompose( cc0, OtherState%Glb_crv, cc, FLAG_R1R2 ) ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) y%BldMotion%Orientation(1:3,1:3,temp_id2) = TRANSPOSE(temp_R) ! Calculate the translation velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationVel(1:3,temp_id2) = MATMUL(p%GlbRot, m%qp%vvv(1:3,j,i)) + y%BldMotion%TranslationVel(1:3,temp_id2) = MATMUL(OtherState%GlbRot,m%qp%vvv(1:3,j,i)) ! Calculate the rotational velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. - y%BldMotion%RotationVel(1:3,temp_id2) = MATMUL(p%GlbRot, m%qp%vvv(4:6,j,i)) + y%BldMotion%RotationVel(1:3,temp_id2) = MATMUL(OtherState%GlbRot,m%qp%vvv(4:6,j,i)) ENDDO ENDDO @@ -722,11 +726,12 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, m, y) END SUBROUTINE Set_BldMotion_NoAcc !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates values for the y%BldMotion mesh. -SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) +SUBROUTINE Set_BldMotion_Mesh(p, u, x, OtherState, m, y) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t - in the FAST coordinate system (NOT BD) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables ! intent(out) so that we can update the accelerations here... TYPE(BD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) @@ -740,7 +745,7 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) ! set positions and velocities (not accelerations) - call Set_BldMotion_NoAcc(p, u, x, m, y) + call Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) ! Only need this bit for dynamic cases IF ( p%analysis_type /= BD_STATIC_ANALYSIS ) THEN @@ -748,6 +753,10 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) ! now set the accelerations: ! The first node on the mesh is just the root location: + y%BldMotion%TranslationDisp(:,1) = u%RootMotion%TranslationDisp(:,1) + y%BldMotion%Orientation(:,:,1) = u%RootMotion%Orientation(:,:,1) + y%BldMotion%TranslationVel(:,1) = u%RootMotion%TranslationVel(:,1) + y%BldMotion%RotationVel(:,1) = u%RootMotion%RotationVel(:,1) y%BldMotion%TranslationAcc(:,1) = u%RootMotion%TranslationAcc(:,1) y%BldMotion%RotationAcc(:,1) = u%RootMotion%RotationAcc(:,1) @@ -761,9 +770,9 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) temp_id = (i-1)*(p%nodes_per_elem-1)+j temp_id2= (i-1)*p%nodes_per_elem+j - y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(p%GlbRot, m%RHS(1:3,temp_id) ) + y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot, m%RHS(1:3,temp_id) ) - y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(p%GlbRot, m%RHS(4:6,temp_id) ) + y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot, m%RHS(4:6,temp_id) ) ENDDO j_start = 1 ENDDO @@ -789,9 +798,9 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, m, y) ! Calculate the translational acceleration of each quadrature node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%aaa(1:3,j,i) ) + y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot,m%qp%aaa(1:3,j,i) ) - y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(p%GlbRot, m%qp%aaa(4:6,j,i) ) + y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot, m%qp%aaa(4:6,j,i) ) ENDDO j_start = 1 ENDDO @@ -834,9 +843,9 @@ SUBROUTINE Set_BldMotion_InitAcc(p, u, OtherState, m, y) temp_id = (i-1)*(p%nodes_per_elem-1)+j temp_id2= (i-1)*p%nodes_per_elem+j - y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(p%GlbRot, OtherState%Acc(1:3,temp_id) ) + y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot, OtherState%Acc(1:3,temp_id) ) - y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(p%GlbRot, OtherState%Acc(4:6,temp_id) ) + y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot, OtherState%Acc(4:6,temp_id) ) ENDDO j_start = 1 ENDDO @@ -852,9 +861,9 @@ SUBROUTINE Set_BldMotion_InitAcc(p, u, OtherState, m, y) ! Calculate the translational acceleration of each quadrature node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(p%GlbRot,m%qp%aaa(1:3,j,i) ) + y%BldMotion%TranslationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot,m%qp%aaa(1:3,j,i) ) - y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(p%GlbRot, m%qp%aaa(4:6,j,i) ) + y%BldMotion%RotationAcc(1:3,temp_id2) = MATMUL(OtherState%GlbRot, m%qp%aaa(4:6,j,i) ) ENDDO j_start = 1 ENDDO @@ -1095,9 +1104,10 @@ SUBROUTINE BD_ComputeIniNodalCrv(e3, phi, cc, ErrStat, ErrMsg) END SUBROUTINE BD_ComputeIniNodalCrv !----------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ExtractRelativeRotation(R, p, rr, ErrStat, ErrMsg) +SUBROUTINE ExtractRelativeRotation(R, p, OtherState, rr, ErrStat, ErrMsg) real(R8Ki), INTENT(in ) :: R(3,3) !< input rotation matrix (transpose of DCM; in BD coords) type(BD_ParameterType), INTENT(in ) :: p !< Parameters + TYPE(BD_OtherStateType),INTENT(IN ) :: OtherState !< Other states at t real(BDKi), INTENT( OUT) :: rr(3) !< W-M parameters of relative rotation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -1117,7 +1127,7 @@ SUBROUTINE ExtractRelativeRotation(R, p, rr, ErrStat, ErrMsg) ! which is the same as operation as ! R(rr) = R(Glb_crv)^T R - ! note that the u%RootMotion mesh does not contain the initial twist, but p%Glb_crv does not have this twist, either. + ! note that the u%RootMotion mesh does not contain the initial twist, but OtherState%Glb_crv does not have this twist, either. ! The relative rotation will be the same in this case. R_BD = R ! possible type conversion (only if BDKi /= R8Ki) @@ -1125,7 +1135,7 @@ SUBROUTINE ExtractRelativeRotation(R, p, rr, ErrStat, ErrMsg) CALL BD_CrvExtractCrv(R_BD,R_WM, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - CALL BD_CrvCompose(rr,p%Glb_crv,R_WM,FLAG_R1TR2) ! rr = p%Glb_crv^- composed with R_WM + CALL BD_CrvCompose(rr,OtherState%Glb_crv,R_WM,FLAG_R1TR2) ! rr = OtherState%Glb_crv^- composed with R_WM ! NOTE: the above calculation is not the inverse of what is in Set_BldMotion_NoAcc. The reason is that this ! routine is only looking at RootMotion. The Set_BldMotion_NoAcc routine is looking at the blade motion @@ -1133,9 +1143,10 @@ SUBROUTINE ExtractRelativeRotation(R, p, rr, ErrStat, ErrMsg) END SUBROUTINE ExtractRelativeRotation !----------------------------------------------------------------------------------------------------------------------------------- -FUNCTION BDrot_to_FASTdcm(rr,p) RESULT(dcm) +FUNCTION BDrot_to_FASTdcm(rr,p,OtherState) RESULT(dcm) real(BDKi), intent(in) :: rr(3) !< W-M parameters of relative rotation type(BD_ParameterType), intent(in) :: p !< Parameters + type(BD_OtherStateType),intent(in) :: OtherState !< Other states at t real(BDKi) :: dcm(3,3) !< input rotation matrix (transpose of DCM; in BD coords) @@ -1147,7 +1158,7 @@ FUNCTION BDrot_to_FASTdcm(rr,p) RESULT(dcm) ! are zero, and the expression in Set_BldMotion_NoAcc simplifies to this expression. ! rotate relative W-M rotations to global system? - CALL BD_CrvCompose(temp_CRV2,p%Glb_crv,rr,FLAG_R1R2) !temp_CRV2 = p%Glb_crv composed with rr + CALL BD_CrvCompose(temp_CRV2,OtherState%Glb_crv,rr,FLAG_R1R2) !temp_CRV2 = OtherState%Glb_crv composed with rr ! create rotation matrix from W-M parameters: CALL BD_CrvMatrixR(temp_CRV2,R) ! returns R (rotation matrix, the transpose of the DCM orientation matrix) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 4bb2d48a81..033f8d80c1 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -145,8 +145,11 @@ MODULE BeamDyn_Types 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 = .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) [-] + 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) [-] + REAL(R8Ki) , DIMENSION(1:3) :: GlbPos !< Position Vector between origins of Global (moving frame) and blade frames (BD coordinates) Follows the RootMotion mesh [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Rotation Tensor between Global (moving frame) and Blade frames (BD coordinates; transfers local to global). Follows the RootMotion mesh [-] + REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv !< CRV parameters of GlbRot. Follows the RootMotion mesh [-] END TYPE BD_OtherStateType ! ======================= ! ========= qpParam ======= @@ -168,15 +171,12 @@ MODULE BeamDyn_Types 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 = 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) :: 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(:), 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) [-] @@ -1152,25 +1152,41 @@ subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_DestroyInputFile' ErrStat = ErrID_None - 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 - 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 + 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 + DstOtherStateData%GlbPos = SrcOtherStateData%GlbPos + DstOtherStateData%GlbRot = SrcOtherStateData%GlbRot + DstOtherStateData%Glb_crv = SrcOtherStateData%Glb_crv + END SUBROUTINE BD_CopyOtherState subroutine BD_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1377,15 +1393,274 @@ subroutine BD_UnPackInputFile(Buf, OutData) 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 - integer(IntKi) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'BD_CopyContState' + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(OtherStateData%acc)) THEN + DEALLOCATE(OtherStateData%acc) +ENDIF +IF (ALLOCATED(OtherStateData%xcc)) THEN + DEALLOCATE(OtherStateData%xcc) +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 + 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 + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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 + 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 + 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 + 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 + END SUBROUTINE BD_UnPackOtherState + + 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(SrcContStateData%q)) then @@ -1420,14 +1695,463 @@ subroutine BD_DestroyContState(ContStateData, ErrStat, ErrMsg) 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 + 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 +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_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1485,13 +2209,2134 @@ subroutine BD_UnPackContState(Buf, OutData) 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 - character(*), parameter :: RoutineName = 'BD_CopyDiscState' + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +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, DEALLOCATEpointers_local ) + 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, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + 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_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 + 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 + 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 + 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_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 = '' DstDiscStateData%thetaP = SrcDiscStateData%thetaP diff --git a/modules/beamdyn/src/Driver_Beam.f90 b/modules/beamdyn/src/Driver_Beam.f90 index eed92052de..85cadc904a 100644 --- a/modules/beamdyn/src/Driver_Beam.f90 +++ b/modules/beamdyn/src/Driver_Beam.f90 @@ -136,7 +136,7 @@ PROGRAM BeamDyn_Driver_Program call Init_RotationCenterMesh(DvrData, BD_InitInput, BD_Input(1)%RootMotion, ErrStat, ErrMsg) CALL CheckError() - call CreateMultiPointMeshes(DvrData,BD_InitInput,BD_InitOutput,BD_Parameter, BD_Output, BD_Input(1), ErrStat, ErrMsg) + call CreateMultiPointMeshes(DvrData,BD_InitInput,BD_InitOutput,BD_Parameter,BD_OtherState, BD_Output, BD_Input(1), ErrStat, ErrMsg) call Transfer_MultipointLoads(DvrData, BD_Output, BD_Input(1), ErrStat, ErrMsg) CALL Dvr_InitializeOutputFile(DvrOut,BD_InitOutput,RootName,ErrStat,ErrMsg) diff --git a/modules/beamdyn/src/Driver_Beam_Subs.f90 b/modules/beamdyn/src/Driver_Beam_Subs.f90 index 7d8141b7c8..27e535105f 100644 --- a/modules/beamdyn/src/Driver_Beam_Subs.f90 +++ b/modules/beamdyn/src/Driver_Beam_Subs.f90 @@ -331,12 +331,13 @@ SUBROUTINE Dvr_WriteOutputLine(t,OutUnit, OutFmt, Output) end subroutine Dvr_WriteOutputLine !---------------------------------------------------------------------------------------------------------------------------------- -subroutine CreateMultiPointMeshes(DvrData,BD_InitInput,BD_InitOutput,BD_Parameter,y, u, ErrStat,ErrMsg) +subroutine CreateMultiPointMeshes(DvrData,BD_InitInput,BD_InitOutput,BD_Parameter,BD_OtherState,y, u, ErrStat,ErrMsg) TYPE(BD_DriverInternalType), INTENT(INOUT) :: DvrData TYPE(BD_InitInputType) , INTENT(IN ) :: BD_InitInput TYPE(BD_InitOutputType) , INTENT(IN ) :: BD_InitOutput TYPE(BD_ParameterType) , INTENT(IN ) :: BD_Parameter + TYPE(BD_OtherStateType) , INTENT(IN ) :: BD_OtherState TYPE(BD_OutputType), INTENT(IN ) :: y TYPE(BD_InputType), INTENT(INOUT) :: u ! sets pointLoad with values from BD driver input file INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation @@ -387,10 +388,10 @@ subroutine CreateMultiPointMeshes(DvrData,BD_InitInput,BD_InitOutput,BD_Paramete CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - Pos = BD_Parameter%GlbPos + MATMUL(BD_Parameter%GlbRot,temp_POS) + Pos = BD_OtherState%GlbPos + MATMUL(BD_OtherState%GlbRot,temp_POS) - temp_CRV2 = MATMUL(BD_Parameter%GlbRot,temp_CRV) - CALL BD_CrvCompose(temp_CRV,BD_Parameter%Glb_crv,temp_CRV2,FLAG_R1R2) !temp_CRV = p%Glb_crv composed with temp_CRV2 + temp_CRV2 = MATMUL(BD_OtherState%GlbRot,temp_CRV) + CALL BD_CrvCompose(temp_CRV,BD_OtherState%Glb_crv,temp_CRV2,FLAG_R1R2) !temp_CRV = m%Glb_crv composed with temp_CRV2 CALL BD_CrvMatrixR(temp_CRV,TmpDCM) ! returns TmpDCM (the transpose of the DCM orientation matrix) diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index b9fc09aa06..28fed73f7a 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -145,6 +145,10 @@ typedef ^ OtherStateType ^ xcc {:}{:} - - "Algorithm acceler #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ OtherStateType Logical InitAcc - - - "flag to determine if accerlerations have been initialized in updateStates" typedef ^ OtherStateType Logical RunQuasiStaticInit - - - "flag to determine if quasi-static solution initialization should be run again (with load inputs)" - +# reference frame -- this follows the root motion mesh +typedef ^ OtherStateType R8Ki GlbPos {3} - - "Position Vector between origins of Global (moving frame) and blade frames (BD coordinates) Follows the RootMotion mesh" - +typedef ^ OtherStateType R8Ki GlbRot {3}{3} - - "Rotation Tensor between Global (moving frame) and Blade frames (BD coordinates; transfers local to global). Follows the RootMotion mesh" - +typedef ^ OtherStateType R8Ki Glb_crv {3} - - "CRV parameters of GlbRot. Follows the RootMotion mesh" - # Quadrature point info that does not change throughout the simulation @@ -181,9 +185,6 @@ typedef ^ ParameterType ^ blade_CG {3} - - typedef ^ ParameterType ^ blade_IN {3}{3} - - "Blade Length" - typedef ^ ParameterType ^ beta {6} - - "Damping Coefficient" - typedef ^ ParameterType ^ tol - - - "Tolerance used in stopping criterion" - -typedef ^ ParameterType ^ GlbPos {3} - - "Initial Position Vector between origins of Global and blade frames (BD coordinates)" - -typedef ^ ParameterType ^ GlbRot {3}{3} - - "Initial Rotation Tensor between Global and Blade frames (BD coordinates; transfers local to global)" - -typedef ^ ParameterType ^ Glb_crv {3} - - "CRV parameters of GlbRot" - typedef ^ ParameterType ^ QPtN {:} - - "Quadrature (QuadPt) point locations in natural frame [-1, 1]" - typedef ^ ParameterType ^ QPtWeight {:} - - "Weights at each quadrature point (QuadPt)" - typedef ^ ParameterType ^ Shp {:}{:} - - "Shape function matrix (index 1 = FE nodes; index 2=quadrature points)" - diff --git a/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 b/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 index 255f75f8c3..94e56e330f 100644 --- a/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 +++ b/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 @@ -22,6 +22,7 @@ subroutine test_BD_InputGlobalLocal() integer :: i, totalnodes type(BD_ParameterType) :: parametertype + type(BD_OtherStateType) :: otherstate type(BD_InputType) :: inputtype real(BDKi), dimension(3) :: vectorInit, vectorAfterRotation, rotationaxis integer(IntKi) :: ErrStat @@ -44,7 +45,8 @@ subroutine test_BD_InputGlobalLocal() ! build the parameter type parametertype%node_total = totalnodes - parametertype%GlbRot = calcRotationMatrix(real(Pi, BDKi), rotationaxis) + otherstate=simpleOtherState() + otherstate%GlbRot = calcRotationMatrix(real(Pi, BDKi), rotationaxis) ! build the inputs call AllocAry(inputtype%RootMotion%TranslationDisp, 3, 1, 'TranslationDisp', ErrStat, ErrMsg) @@ -74,10 +76,10 @@ subroutine test_BD_InputGlobalLocal() end do call AllocAry(inputtype%RootMotion%Orientation, 3, 3, totalnodes, 'RootMotion%Orientation', ErrStat, ErrMsg) - inputtype%RootMotion%Orientation(:,:,1) = parametertype%GlbRot + inputtype%RootMotion%Orientation(:,:,1) = otherstate%GlbRot ! call the subroutine to test - call BD_InputGlobalLocal(parametertype, inputtype) + call BD_InputGlobalLocal(parametertype, otherstate, inputtype) ! test the values @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationDisp(:,1), BDKi), tolerance, testname) @@ -97,6 +99,6 @@ subroutine test_BD_InputGlobalLocal() @assertEqual(vectorAfterRotation, real(inputtype%DistrLoad%Moment(1:3,i), BDKi), tolerance, testname) end do - @assertEqual(transpose(parametertype%GlbRot), inputtype%RootMotion%Orientation(:,:,1), tolerance, testname) + @assertEqual(transpose(otherstate%GlbRot), inputtype%RootMotion%Orientation(:,:,1), tolerance, testname) end subroutine diff --git a/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 b/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 index 25c1c01dcf..669d132e58 100644 --- a/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 +++ b/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 @@ -16,6 +16,7 @@ subroutine test_ExtractRelativeRotation() character :: ErrMsg type(BD_ParameterType) :: parametertype + type(BD_OtherStateType) :: otherstate ! initialize NWTC_Num constants call SetConstants() @@ -26,9 +27,10 @@ subroutine test_ExtractRelativeRotation() ! -------------------------------------------------------------------------- testname = "static simple beam under gravity:" + otherstate = simpleOtherState() parametertype = simpleParameterType(1,16,16,0,0) - call ExtractRelativeRotation(identity(), parametertype, rr, ErrStat, ErrMsg) + call ExtractRelativeRotation(identity(), parametertype, otherstate, rr, ErrStat, ErrMsg) @assertEqual((/ 0.0, 0.0, 0.0 /), rr, tolerance, testname) end subroutine diff --git a/modules/beamdyn/tests/test_tools.F90 b/modules/beamdyn/tests/test_tools.F90 index 9224dfceb9..b936d3bffa 100644 --- a/modules/beamdyn/tests/test_tools.F90 +++ b/modules/beamdyn/tests/test_tools.F90 @@ -91,6 +91,11 @@ function getGravityInZ() getGravityInZ = (/ 0.0, 0.0, -9.806 /) end function + type(BD_OtherStateType) function simpleOtherState() result(otherstate) + ! fixed size arrays + otherstate%Glb_crv = (/ 0.0, 0.0, 0.0 /) + otherstate%GlbRot = identity() + end function type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) RESULT(p) integer, intent(in ) :: elem_total @@ -111,10 +116,6 @@ type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, p%dof_node = 6 - ! fixed size arrays - p%Glb_crv = (/ 0.0, 0.0, 0.0 /) - p%GlbRot = identity() - ! allocate arrays call AllocAry(p%qp%mmm, p%nqp, p%elem_total, 'qp_mmm', ErrStat, ErrMsg) call AllocAry(p%qp%mEta, 3, p%nqp, p%elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) From e6841d7825e5f8683a3cbc7f93f659efdf3f2b0c Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 28 Aug 2023 13:38:32 -0600 Subject: [PATCH 22/61] BD Refchange: store gravity vector in inertial frame may have positions in mesh partially correct. Rotations appear too far though, so something wrong with rotation handling --- modules/beamdyn/src/BeamDyn.f90 | 115 ++++++++++++++++++----- modules/beamdyn/src/BeamDyn_Subs.f90 | 9 +- modules/beamdyn/src/Registry_BeamDyn.txt | 2 +- 3 files changed, 100 insertions(+), 26 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 1d648aa935..22ac4948d6 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -176,7 +176,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I call Init_OtherStates(u, p, OtherState, ErrStat2, ErrMsg2); if (Failed()) return ! initialize outputs (need to do this after initializing inputs and parameters (p%nnu0)) - call Init_y(p, OtherSTate, u, y, ErrStat2, ErrMsg2); if (Failed()) return + call Init_y(p, OtherState, u, y, ErrStat2, ErrMsg2); if (Failed()) return ! allocate and initialize misc vars (do this after initializing input and output meshes): call Init_MiscVars(p, u, y, MiscVar, ErrStat2, ErrMsg2); if (Failed()) return @@ -1069,7 +1069,7 @@ subroutine SetRefFrame( u, OtherState, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - ! Calculate new global position, rotation, and WM from root motion. Note that this is similar to the InitRefFrame routine + ! Calculate new global position, rotation, and WM from root motion. Note that this is similar to the InitRefFrame routine OtherState%GlbPos = u%RootMotion%Position(:, 1) + & u%RootMotion%TranslationDisp(:, 1) OtherState%GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) @@ -1106,8 +1106,8 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) ErrMsg = "" - ! Gravity vector - p%gravity = MATMUL(InitInp%gravity,OtherState%GlbRot) + ! Gravity vector -- inertial frame! This must be multiplied by OtherState%GlbRot to get into the BD rotating reference frame + p%gravity = InitInp%gravity !.................... @@ -2307,13 +2307,13 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, CALL BD_QPDataVelocity( p, x_tmp, m ) ! x%dqdt --> m%qp%vvv, m%qp%vvp ! calculate accelerations and reaction loads (in m%RHS): - CALL BD_CalcForceAcc(m%u, p, m, ErrStat2,ErrMsg2) + CALL BD_CalcForceAcc(m%u, p, OtherState, m, ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE ! Calculate the elastic forces for the static case. DO nelem=1,p%elem_total - CALL BD_StaticElementMatrix( nelem, p%gravity, p, m ) + CALL BD_StaticElementMatrix( nelem, MATMUL(p%gravity,OtherState%GlbRot), p, m ) ENDDO ENDIF @@ -2443,7 +2443,7 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL BD_QPDataVelocity( p, dxdt, m ) ! x%dqdt --> m%qp%vvv, m%qp%vvp ! calculate accelerations and reaction loads (in m%RHS): - CALL BD_CalcForceAcc(m%u, p, m, ErrStat2,ErrMsg2) + CALL BD_CalcForceAcc(m%u, p, OtherState, m, ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -3476,10 +3476,11 @@ END SUBROUTINE BD_AssembleRHS !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine total element forces and mass matrices !FIXME: note similarities with BD_ElementMatrixGA2 -SUBROUTINE BD_ElementMatrixAcc( nelem, p, m ) +SUBROUTINE BD_ElementMatrixAcc( nelem, p, OtherState, m ) INTEGER(IntKi), INTENT(IN ) :: nelem !< number of current element TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< other states -- includes the orientation TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables CHARACTER(*), PARAMETER :: RoutineName = 'BD_ElementMatrixAcc' @@ -3489,7 +3490,7 @@ SUBROUTINE BD_ElementMatrixAcc( nelem, p, m ) IF(p%damp_flag .NE. 0) THEN CALL BD_DissipativeForce( nelem, p, m, .FALSE. ) ! Calculate dissipative terms on Fc, Fd ENDIF - CALL BD_GravityForce( nelem, p, m, p%gravity ) ! Calculate Fg + CALL BD_GravityForce( nelem, p, m, MATMUL(p%gravity,OtherState%GlbRot) ) ! Calculate Fg CALL BD_GyroForce( nelem, p, m ) ! Calculate Fb (velocity terms from InertialForce with aaa=0) CALL BD_InertialMassMatrix( nelem, p, m ) ! Calculate Mi @@ -3685,7 +3686,7 @@ SUBROUTINE BD_Static(t,u,utimes,p,x,OtherState,m,ErrStat,ErrMsg) DO j=1,p%ld_retries CALL BD_DistrLoadCopy( p, u_interp, m, load_test ) ! move the input loads from u_interp into misc vars - gravity_temp(:) = p%gravity(:)*load_test + gravity_temp(:) = MATMUL(p%gravity,OtherState%GlbRot)*load_test CALL BD_StaticSolution(x, gravity_temp, p, m, piter, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName) ! concerned about error reporting @@ -4380,7 +4381,7 @@ SUBROUTINE BD_GenerateQuasiStaticElement( x, OtherState, p, m ) DO nelem=1,p%elem_total - CALL BD_QuasiStaticElementMatrix( nelem, p, m ) + CALL BD_QuasiStaticElementMatrix( nelem, p, OtherState, m ) CALL BD_AssembleStiffK(nelem,p,m%elk,m%StifK) CALL BD_AssembleRHS(nelem,p,m%elf,m%RHS) @@ -4391,10 +4392,11 @@ END SUBROUTINE BD_GenerateQuasiStaticElement !----------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE BD_QuasiStaticElementMatrix( nelem, p, m ) +SUBROUTINE BD_QuasiStaticElementMatrix( nelem, p, OtherState, m ) INTEGER(IntKi), INTENT(IN ) :: nelem !< current element number TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< other states (contains global rotation to get gravity in correct orientation) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables INTEGER(IntKi) :: i @@ -4405,7 +4407,7 @@ SUBROUTINE BD_QuasiStaticElementMatrix( nelem, p, m ) CALL BD_ElasticForce( nelem,p,m,.true. ) ! Calculate Fc, Fd [and Oe, Pe, and Qe for N-R algorithm] - CALL BD_GravityForce( nelem,p,m,p%gravity ) ! Calculate Fg + CALL BD_GravityForce( nelem,p,m,MATMUL(p%gravity,OtherState%GlbRot) ) ! Calculate Fg ! NOTE: we only use Ki (not Gi or Mi as we are not calculating \delta{a} or \delta{v}) CALL BD_InertialForce( nelem,p,m,.true. ) ! Calculate Fi [and Mi, Gi, Ki] @@ -4700,7 +4702,7 @@ SUBROUTINE BD_GA2(t,n,u,utimes,p,x,xd,z,OtherState,m,ErrStat,ErrMsg) end if ! initialize the accelerations in OtherState%Acc - CALL BD_InitAcc( u_interp, p, x, m, OtherState%Acc, ErrStat2, ErrMsg2) + CALL BD_InitAcc( u_interp, p, x, OtherState, m, OtherState%Acc, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then call cleanup() @@ -5201,7 +5203,7 @@ SUBROUTINE BD_GenerateDynamicElementGA2( x, OtherState, p, m, fact ) DO nelem=1,p%elem_total ! compute m%elk,m%elf,m%elm,m%elg: - CALL BD_ElementMatrixGA2(fact, nelem, p, m ) + CALL BD_ElementMatrixGA2(fact, nelem, p, OtherState, m ) IF(fact) THEN CALL BD_AssembleStiffK(nelem,p,m%elk,m%StifK) @@ -5217,9 +5219,10 @@ END SUBROUTINE BD_GenerateDynamicElementGA2 !----------------------------------------------------------------------------------------------------------------------------------- !FIXME: lots of pieces of BD_ElementMatrixAcc show up in here -SUBROUTINE BD_ElementMatrixGA2( fact, nelem, p, m ) +SUBROUTINE BD_ElementMatrixGA2( fact, nelem, p, OtherState, m ) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< other states (contains global orientation to get gravity in right direction) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables LOGICAL, INTENT(IN ) :: fact !< are we factoring? @@ -5244,7 +5247,7 @@ SUBROUTINE BD_ElementMatrixGA2( fact, nelem, p, m ) CALL BD_DissipativeForce( nelem,p,m,fact ) ! Calculate dissipative terms on Fc, Fd [and Sd, Od, Pd and Qd, betaC, Gd, Xd, Yd for N-R algorithm] ENDIF - CALL BD_GravityForce( nelem, p, m, p%gravity ) + CALL BD_GravityForce( nelem, p, m, MATMUL(p%gravity,OtherState%GlbRot) ) @@ -5681,11 +5684,12 @@ END SUBROUTINE BD_CalcCentripAcc !----------------------------------------------------------------------------------------------------------------------------------- !! Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE BD_InitAcc( u, p, x, m, qdotdot, ErrStat, ErrMsg ) +SUBROUTINE BD_InitAcc( u, p, x, OtherState, m, qdotdot, ErrStat, ErrMsg ) TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t (in BD coordinates) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables REAL(BDKi), INTENT( OUT) :: qdotdot(:,:) !< accelerations INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -5709,7 +5713,7 @@ SUBROUTINE BD_InitAcc( u, p, x, m, qdotdot, ErrStat, ErrMsg ) CALL BD_QPDataVelocity(p, x, m) ! set misc vars, particularly m%RHS - CALL BD_CalcForceAcc( u, p, m, ErrStat2, ErrMsg2 ) + CALL BD_CalcForceAcc( u, p, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! set accelerations with inputs from the root and BD_CalcForceAcc solution @@ -5793,10 +5797,11 @@ END SUBROUTINE BD_InitAcc !! !! The root reaction force is therefore calculated afterwards as !! \f$ F_\textrm{root} = f_1 - \sum_{i} m_{1,i} a_{i} \f$. -SUBROUTINE BD_CalcForceAcc( u, p, m, ErrStat, ErrMsg ) +SUBROUTINE BD_CalcForceAcc( u, p, OtherState, m, ErrStat, ErrMsg ) TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< other states (contains ref orientation) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -5823,7 +5828,7 @@ SUBROUTINE BD_CalcForceAcc( u, p, m, ErrStat, ErrMsg ) ! Calculate the global mass matrix and force vector for the beam DO nelem=1,p%elem_total - CALL BD_ElementMatrixAcc( nelem, p, m ) ! Calculate m%elm and m%elf + CALL BD_ElementMatrixAcc( nelem, p, OtherState, m ) ! Calculate m%elm and m%elf CALL BD_AssembleStiffK(nelem,p,m%elm, m%MassM) ! Assemble full mass matrix CALL BD_AssembleRHS(nelem,p,m%elf, m%RHS) ! Assemble right hand side force terms ENDDO @@ -6786,6 +6791,26 @@ END SUBROUTINE cleanup END SUBROUTINE BD_WriteMassStiffInFirstNodeFrame !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Update the state information to follow the blade rootmotion mesh. +!! - move the state information in x from the previous reference frame at time T (u(2)%rootmotion) to the new reference frame at T+dt (u(1)%rootmation) +!! - the GlbRot, GlbPos, and Glb_crv values are stored as otherstates and updated +!! - +subroutine UpdateBeamDynGlobalReference(u,p,x,OtherState,ErrStat,ErrMsg) + type(BD_InputType), intent(in ) :: u !< Inputs at utimes + type(BD_ParameterType), intent(in ) :: p !< Parameters + type(BD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; + type(BD_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t; + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(*), parameter :: RoutineName = 'UpdateBeamDynGlobalReference' + real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) + real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) + real(R8Ki) :: GlbPos_old(3), GlbPos_new(3), GlbPos_diff(3) + real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) + integer(IntKi) :: i, j, temp_id, temp_id2 subroutine BD_PackStateValues(p, x, Values) type(BD_ParameterType), intent(in) :: p type(BD_ContinuousStateType), intent(in) :: x @@ -6805,6 +6830,8 @@ subroutine BD_PackStateValues(p, x, Values) end do end subroutine + ErrStat = ErrID_None + ErrMsg = "" subroutine BD_UnpackStateValues(p, Values, x) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) @@ -6824,6 +6851,10 @@ subroutine BD_UnpackStateValues(p, Values, x) end do end subroutine + ! Save old global position, rotation, and WM + GlbPos_old = OtherState%GlbPos + GlbRot_old = OtherState%GlbRot + GlbWM_old = OtherState%Glb_crv subroutine BD_PackInputValues(p, u, Values) type(BD_ParameterType), intent(in) :: p type(BD_InputType), intent(in) :: u @@ -6835,6 +6866,11 @@ subroutine BD_PackInputValues(p, u, Values) call MV_PackMesh(p%Vars%u, iv, u%DistrLoad, Values) end subroutine + ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) + call SetRefFrame(u,OtherState,ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + GlbPos_new = OtherState%GlbPos + GlbRot_new = OtherState%GlbRot + GlbWM_new = OtherState%Glb_crv subroutine BD_UnpackInputValues(p, Values, u) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) @@ -6846,6 +6882,43 @@ subroutine BD_UnpackInputValues(p, Values, u) call MV_UnpackMesh(p%Vars%u, iv, Values, u%DistrLoad) end subroutine + ! Calculate differences between old and new reference + GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) + !GlbWM_diff = wm_compose(wm_inv(GlbWM_old), GlbWM_new) + call BD_CrvCompose(GlbWM_diff, GlbWM_old, GlbWM_new, FLAG_R1TR2) + GlbPos_diff = GlbPos_old - GlbPos_new + + + ! Root node is always aligned with root motion mesh + x%q(:, 1) = 0.0_R8Ki + x%dqdt(1:3, 1) = matmul(transpose(GlbRot_new), u%RootMotion%TranslationVel(:, 1)) + x%dqdt(4:6, 1) = matmul(transpose(GlbRot_new), u%RootMotion%RotationVel(:, 1)) + + do i = 1, p%elem_total + do j = 1, p%nodes_per_elem + + temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. + temp_id2 = (i - 1)*p%nodes_per_elem + j ! Index to a node within element i + + ! Calculate displacement in terms of new root motion mesh position + x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & + GlbPos_old + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + GlbPos_new - matmul(GlbRot_new, p%uuN0(1:3, j, i))) + + ! Update the node orientation rotation of the node + !x%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x%q(4:6, temp_id)) + call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1TR2) + + ! Update the translational velocity + x%dqdt(1:3, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(1:3, temp_id)) + + ! Update the rotational velocity + x%dqdt(4:6, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(4:6, temp_id)) + + end do + end do +end subroutine + subroutine BD_PackOutputValues(p, y, Values) type(BD_ParameterType), intent(in) :: p type(BD_OutputType), intent(in) :: y diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index 77e53c3fb2..90841199ba 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -658,7 +658,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) ! Calculate the translational displacement of each GLL node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos + matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & - y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uuN0(1:3, j, i)) + y%BldMotion%Position(1:3,temp_id2) !bjj: note differences here compared to BDrot_to_FASTdcm !adp: in BDrot_to_FASTdcm we are assuming that x%q(4:6,:) is zero because there is no rotatinoal displacement yet @@ -671,7 +671,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) CALL BD_CrvMatrixR(cc0,temp_R) ! returns temp_R (the transpose of the DCM orientation matrix) ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) - y%BldMotion%Orientation(1:3,1:3,temp_id2) = TRANSPOSE(temp_R) + y%BldMotion%Orientation(1:3,1:3,temp_id2) = MATMUL(OtherState%GlbRot,TRANSPOSE(temp_R)) ! Calculate the translation velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. @@ -696,7 +696,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) ! Calculate the translational displacement of each quadrature node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos + matmul(OtherState%GlbRot, p%uu0(1:3, j, i) + m%qp%uuu(1:3,j,i)) - & - y%BldMotion%Position(1:3,1) - matmul(y%BldMotion%RefOrientation(:,:,1), p%uu0(1:3, j, i)) + y%BldMotion%Position(1:3,temp_id2) !bjj: note differences here compared to BDrot_to_FASTdcm @@ -706,7 +706,8 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) CALL BD_CrvCompose( cc, m%qp%uuu(4:6,j,i), p%uu0(4:6,j,i), FLAG_R1R2 ) CALL BD_CrvCompose( cc0, OtherState%Glb_crv, cc, FLAG_R1R2 ) - ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) + CALL BD_CrvMatrixR(cc0,temp_R) ! returns temp_R (the transpose of the DCM orientation matrix) + ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) y%BldMotion%Orientation(1:3,1:3,temp_id2) = TRANSPOSE(temp_R) ! Calculate the translation velocity and store in FAST coordinate system diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 28fed73f7a..d48b5b7651 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -176,7 +176,7 @@ typedef ^ ParameterType R8Ki uuN0 {:}{:}{:} - - typedef ^ ParameterType ^ twN0 {:}{:} - - "Initial Twist of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element)" - typedef ^ ParameterType ^ Stif0_QP {:}{:}{:} - - "Sectional Stiffness Properties at quadrature points (6x6xqp)" - typedef ^ ParameterType ^ Mass0_QP {:}{:}{:} - - "Sectional Mass Properties at quadrature points (6x6xqp)" - -typedef ^ ParameterType ^ gravity {3} - - "Gravitational acceleration" m/s^2 +typedef ^ ParameterType ^ gravity {3} - - "Gravitational acceleration -- intertial frame!!!" m/s^2 typedef ^ ParameterType ^ segment_eta {:} - - "Array stored length ratio of each segment w.r.t. member it lies in" - typedef ^ ParameterType ^ member_eta {:} - - "Array stored length ratio of each member w.r.t. entire blade" - typedef ^ ParameterType ^ blade_length - - - "Blade Length" - From 54cecebb5eafdfbd75967fcc12b6374d4b0beddf Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 28 Aug 2023 15:16:37 -0600 Subject: [PATCH 23/61] BD RefChange: fix some translation displacement issues --- modules/beamdyn/src/BeamDyn.f90 | 101 +++++++------------------------- 1 file changed, 20 insertions(+), 81 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 22ac4948d6..ba31f43a87 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -50,6 +50,8 @@ MODULE BeamDyn ! states(z) PUBLIC :: BD_GetOP !< Routine to pack the operating point values (for linearization) into arrays + PUBLIC :: UpdateBeamDynGlobalReference !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh + ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT CONTAINS @@ -169,12 +171,12 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ! Define and initialize system inputs (set up and initialize input meshes) here: call Init_u(InitInp, p, OtherState, u, ErrStat2, ErrMsg2); if (Failed()) return + ! allocate and initialize other states: Also sets the GlbRot for the displaced position (needed for x%q initialization) + call Init_OtherStates(u, p, OtherState, ErrStat2, ErrMsg2); if (Failed()) return + ! allocate and initialize continuous states (need to do this after initializing inputs): call Init_ContinuousStates(p, u, x, OtherState, ErrStat2, ErrMsg2); if (Failed()) return - ! allocate and initialize other states: - call Init_OtherStates(u, p, OtherState, ErrStat2, ErrMsg2); if (Failed()) return - ! initialize outputs (need to do this after initializing inputs and parameters (p%nnu0)) call Init_y(p, OtherState, u, y, ErrStat2, ErrMsg2); if (Failed()) return @@ -2114,84 +2116,24 @@ SUBROUTINE BD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = "" IF(p%analysis_type /= BD_STATIC_ANALYSIS) THEN ! dynamic analysis - call SetRefFrame(u(1),OtherState,ErrStat,ErrMsg); if (ErrStat >= AbortErrLev) return - CALL BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - call UpdateBeamDynGlobalReference() ! reference follows the blade root motion mesh + CALL BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,''); if (ErrStat >= AbortErrLev) return + + ! change reference frame to root motion at t=T+DT (u(1)%RootMotionMesh) + call UpdateBeamDynGlobalReference(u(1),p,x,OtherState,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'') ELSE !IF(p%analysis_type == BD_STATIC_ANALYSIS) THEN CALL BD_Static( t, u, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) ENDIF -contains - -subroutine UpdateBeamDynGlobalReference() - character(*), parameter :: RoutineName = 'UpdateBeamDynGlobalReference' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) - real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) - real(R8Ki) :: GlbPos_old(3), GlbPos_new(3), GlbPos_diff(3) - real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) - integer(IntKi) :: i, j, temp_id, temp_id2 - - ErrStat = ErrID_None - ErrMsg = '' - - ! Save old global position, rotation, and WM - GlbPos_old = OtherState%GlbPos - GlbRot_old = OtherState%GlbRot - GlbWM_old = OtherState%Glb_crv - - ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) - call SetRefFrame(u(1),OtherState,ErrStat2,ErrMsg2) - GlbPos_new = OtherState%GlbPos - GlbRot_new = OtherState%GlbRot - GlbWM_new = OtherState%Glb_crv - - ! Calculate differences between old and new reference - GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) - !GlbWM_diff = wm_compose(wm_inv(GlbWM_old), GlbWM_new) - call BD_CrvCompose(GlbWM_diff, GlbWM_old, GlbWM_new, FLAG_R1TR2) - GlbPos_diff = GlbPos_old - GlbPos_new - - - ! Root node is always aligned with root motion mesh - x%q(:, 1) = 0.0_R8Ki - x%dqdt(1:3, 1) = matmul(transpose(GlbRot_diff), u(1)%RootMotion%TranslationVel(:, 1)) - x%dqdt(4:6, 1) = matmul(transpose(GlbRot_diff), u(1)%RootMotion%RotationVel(:, 1)) - - do i = 1, p%elem_total - do j = 1, p%nodes_per_elem - - temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. - temp_id2 = (i - 1)*p%nodes_per_elem + j ! Index to a node within element i - - ! Calculate displacement in terms of new root motion mesh position - x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & - GlbPos_old + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & - GlbPos_new - matmul(GlbRot_new, p%uuN0(1:3, j, i))) - - ! Update the node orientation rotation of the node - !x%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x%q(4:6, temp_id)) - call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1TR2) - - ! Update the translational velocity - x%dqdt(1:3, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(1:3, temp_id)) - - ! Update the rotational velocity - x%dqdt(4:6, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(4:6, temp_id)) - - end do - end do -end subroutine - END SUBROUTINE BD_UpdateStates @@ -2290,7 +2232,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, CALL BD_DistrLoadCopy( p, m%u, m ) ! Incorporate boundary conditions (note that we are doing this because the first node isn't really a state. should fix x so we don't need a temp copy here.) - x_tmp%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + x_tmp%q( 1:3,1) = 0.0_BDKi ! No displacement relative to root CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, x_tmp%q( 4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -4879,13 +4821,10 @@ SUBROUTINE BD_BoundaryGA2(x,p,u,OtherState, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - ! Root displacements - x%q(1:3,1) = u%RootMotion%TranslationDisp(1:3,1) + ! Root displacements -- no displacement relative to the root (reference frame attached to u%RootMotionMesh) + x%q(1:3,1) = 0.0_BDKi + x%q(4:6,1) = 0.0_BDKi - ! Root rotations - CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1), p, OtherState, x%q(4:6,1), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return ! Root velocities/angular velocities and accelerations/angular accelerations x%dqdt(1:3,1) = u%RootMotion%TranslationVel(1:3,1) @@ -5537,7 +5476,7 @@ SUBROUTINE BD_CalcIC_Position( u, p, x, OtherState, ErrStat, ErrMsg) temp_p0 = MATMUL(temp_p0, OtherState%GlbRot ) ! Into the local frame ! Add the root displacement (in local frame) to the reference at current root orientation in local frame, ! and subtract the reference to get the displacement. This is equivalent to TranslationDisp in the local frame. - x%q(1:3,temp_id+j) = u%RootMotion%TranslationDisp(1:3,1) + temp_p0 - p%uuN0(1:3,j,i) + x%q(1:3,temp_id+j) = temp_p0 - p%uuN0(1:3,j,i) ENDDO k = 2 ! start j loop at k=2 for remaining elements (i>1) ENDDO @@ -6902,8 +6841,8 @@ subroutine BD_UnpackInputValues(p, Values, u) ! Calculate displacement in terms of new root motion mesh position x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & - GlbPos_old + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & - GlbPos_new - matmul(GlbRot_new, p%uuN0(1:3, j, i))) + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + matmul(GlbRot_new, p%uuN0(1:3, j, i))) ! Update the node orientation rotation of the node !x%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x%q(4:6, temp_id)) From 128ea2b25ccb7908d40bb539d792c23ff31edc36 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 30 Aug 2023 17:16:26 +0000 Subject: [PATCH 24/61] BeamDyn works in Tight Coupling! --- modules/beamdyn/src/BeamDyn.f90 | 141 +- modules/beamdyn/src/BeamDyn_Subs.f90 | 16 +- modules/beamdyn/src/BeamDyn_Types.f90 | 2979 +------------------- modules/openfast-library/src/FAST_Eval.f90 | 43 +- modules/openfast-library/src/Solver.f90 | 121 +- 5 files changed, 194 insertions(+), 3106 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index ba31f43a87..13a36ccfd0 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -50,7 +50,7 @@ MODULE BeamDyn ! states(z) PUBLIC :: BD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - PUBLIC :: UpdateBeamDynGlobalReference !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh + PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT @@ -213,7 +213,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I end if - CALL Set_BldMotion_NoAcc(p, u, x, OtherState, MiscVar, y) + CALL Set_BldMotion_NoAcc(p, x, OtherState, MiscVar, y) IF(QuasiStaticInitialized) THEN ! Set the BldMotion mesh acceleration but only if quasistatic succeeded @@ -2128,7 +2128,7 @@ SUBROUTINE BD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,''); if (ErrStat >= AbortErrLev) return ! change reference frame to root motion at t=T+DT (u(1)%RootMotionMesh) - call UpdateBeamDynGlobalReference(u(1),p,x,OtherState,ErrStat2,ErrMsg2) + call BD_UpdateGlobalRef(u(1),p,x,OtherState,ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'') ELSE !IF(p%analysis_type == BD_STATIC_ANALYSIS) THEN CALL BD_Static( t, u, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) @@ -2232,7 +2232,8 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, CALL BD_DistrLoadCopy( p, m%u, m ) ! Incorporate boundary conditions (note that we are doing this because the first node isn't really a state. should fix x so we don't need a temp copy here.) - x_tmp%q( 1:3,1) = 0.0_BDKi ! No displacement relative to root + x_tmp%q(1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + & + matmul(m%u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, x_tmp%q( 4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -2262,7 +2263,6 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! Calculate internal forces and moments CALL BD_InternalForceMoment( x_tmp, OtherState, p, m ) - CALL BD_InternalForceMoment( x_tmp, p, m ) ! Transfer the FirstNodeReaction forces to the output ReactionForce y%ReactionForce%Force(:,1) = MATMUL(OtherState%GlbRot,m%FirstNodeReactionLclForceMoment(1:3)) @@ -2271,7 +2271,6 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! set y%BldMotion fields: CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, OtherState, m, y) - CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, m, y) !------------------------------------------------------- ! compute RootMxr and RootMyr for ServoDyn and @@ -2365,15 +2364,11 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL BD_CopyContState(x, dxdt, MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! dxdt%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) - ! CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, dxdt%q( 4:6,1), OtherState, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! if (ErrStat >= AbortErrLev) return - ! dxdt%q( 1:3,1) = m%u%RootMotion%TranslationDisp(:,1) - ! CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p, dxdt%q( 4:6,1), ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! if (ErrStat >= AbortErrLev) return - !dxdt%q( 4:6,1) = ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1),p) + dxdt%q(1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + & + matmul(m%u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) + CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, dxdt%q(4:6,1), ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return dxdt%dqdt(1:3,1) = m%u%RootMotion%TranslationVel(:,1) dxdt%dqdt(4:6,1) = m%u%Rootmotion%RotationVel(:,1) @@ -6735,21 +6730,83 @@ END SUBROUTINE BD_WriteMassStiffInFirstNodeFrame !! - move the state information in x from the previous reference frame at time T (u(2)%rootmotion) to the new reference frame at T+dt (u(1)%rootmation) !! - the GlbRot, GlbPos, and Glb_crv values are stored as otherstates and updated !! - -subroutine UpdateBeamDynGlobalReference(u,p,x,OtherState,ErrStat,ErrMsg) +subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) type(BD_InputType), intent(in ) :: u !< Inputs at utimes type(BD_ParameterType), intent(in ) :: p !< Parameters type(BD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; type(BD_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t; integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= + + character(*), parameter :: RoutineName = 'BD_UpdateGlobalRef' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(*), parameter :: RoutineName = 'UpdateBeamDynGlobalReference' real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) - real(R8Ki) :: GlbPos_old(3), GlbPos_new(3), GlbPos_diff(3) + real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) integer(IntKi) :: i, j, temp_id, temp_id2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Save old global position, rotation, and WM + GlbPos_old = OtherState%GlbPos + GlbRot_old = OtherState%GlbRot + GlbWM_old = OtherState%Glb_crv + + ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) + OtherState%GlbPos = u%RootMotion%Position(:, 1) + & + u%RootMotion%TranslationDisp(:, 1) + OtherState%GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) + OtherState%Glb_crv = wm_from_dcm(OtherState%GlbRot) + + ! Save new global position, rotation, and WM + GlbPos_new = OtherState%GlbPos + GlbRot_new = OtherState%GlbRot + GlbWM_new = OtherState%Glb_crv + + ! Calculate differences between old and new reference + GlbRot_diff = matmul(transpose(GlbRot_new), GlbRot_old) + GlbWM_diff = wm_from_dcm(GlbRot_diff) + + do i = 1, p%elem_total + do j = 1, p%nodes_per_elem + + temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. + + ! Calculate displacement in terms of new root motion mesh position + x%q(1:3, temp_id) = matmul(transpose(GlbRot_new),& + GlbPos_old - GlbPos_new + & + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + matmul(GlbRot_new, p%uuN0(1:3, j, i))) + + ! Update the node orientation + x%q(4:6, temp_id) = wm_compose(GlbWM_diff, x%q(4:6, temp_id)) + end do + end do + + ! Update the translational velocity + x%dqdt(1:3, :) = matmul(GlbRot_diff, x%dqdt(1:3, :)) + + ! Update the rotational velocity + x%dqdt(4:6, :) = matmul(GlbRot_diff, x%dqdt(4:6, :)) + + ! Update translational acceleration + ! OtherState%acc(1:3, :) = matmul(GlbRot_diff, OtherState%acc(1:3, :)) + + ! Update rotational acceleration + ! OtherState%acc(4:6, :) = matmul(GlbRot_diff, OtherState%acc(4:6, :)) + + ! Root node is always aligned with root motion mesh + ! x%q(:, 1) = 0.0_R8Ki + ! x%dqdt(1:3, 1) = matmul(u%RootMotion%TranslationVel(:, 1), GlbRot_new) + ! x%dqdt(4:6, 1) = matmul(u%RootMotion%RotationVel(:, 1), GlbRot_new) + ! OtherState%acc(1:3, 1) = matmul(u%RootMotion%TranslationAcc(:, 1), GlbRot_new) + ! OtherState%acc(4:6, 1) = matmul(u%RootMotion%RotationAcc(:, 1), GlbRot_new) + +end subroutine + subroutine BD_PackStateValues(p, x, Values) type(BD_ParameterType), intent(in) :: p type(BD_ContinuousStateType), intent(in) :: x @@ -6769,8 +6826,6 @@ subroutine BD_PackStateValues(p, x, Values) end do end subroutine - ErrStat = ErrID_None - ErrMsg = "" subroutine BD_UnpackStateValues(p, Values, x) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) @@ -6790,10 +6845,6 @@ subroutine BD_UnpackStateValues(p, Values, x) end do end subroutine - ! Save old global position, rotation, and WM - GlbPos_old = OtherState%GlbPos - GlbRot_old = OtherState%GlbRot - GlbWM_old = OtherState%Glb_crv subroutine BD_PackInputValues(p, u, Values) type(BD_ParameterType), intent(in) :: p type(BD_InputType), intent(in) :: u @@ -6805,11 +6856,6 @@ subroutine BD_PackInputValues(p, u, Values) call MV_PackMesh(p%Vars%u, iv, u%DistrLoad, Values) end subroutine - ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) - call SetRefFrame(u,OtherState,ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return - GlbPos_new = OtherState%GlbPos - GlbRot_new = OtherState%GlbRot - GlbWM_new = OtherState%Glb_crv subroutine BD_UnpackInputValues(p, Values, u) type(BD_ParameterType), intent(in) :: p real(R8Ki), intent(in) :: Values(:) @@ -6821,43 +6867,6 @@ subroutine BD_UnpackInputValues(p, Values, u) call MV_UnpackMesh(p%Vars%u, iv, Values, u%DistrLoad) end subroutine - ! Calculate differences between old and new reference - GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) - !GlbWM_diff = wm_compose(wm_inv(GlbWM_old), GlbWM_new) - call BD_CrvCompose(GlbWM_diff, GlbWM_old, GlbWM_new, FLAG_R1TR2) - GlbPos_diff = GlbPos_old - GlbPos_new - - - ! Root node is always aligned with root motion mesh - x%q(:, 1) = 0.0_R8Ki - x%dqdt(1:3, 1) = matmul(transpose(GlbRot_new), u%RootMotion%TranslationVel(:, 1)) - x%dqdt(4:6, 1) = matmul(transpose(GlbRot_new), u%RootMotion%RotationVel(:, 1)) - - do i = 1, p%elem_total - do j = 1, p%nodes_per_elem - - temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. - temp_id2 = (i - 1)*p%nodes_per_elem + j ! Index to a node within element i - - ! Calculate displacement in terms of new root motion mesh position - x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & - matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & - matmul(GlbRot_new, p%uuN0(1:3, j, i))) - - ! Update the node orientation rotation of the node - !x%q(4:6, temp_id) = wm_compose(wm_inv(GlbWM_diff), x%q(4:6, temp_id)) - call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1TR2) - - ! Update the translational velocity - x%dqdt(1:3, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(1:3, temp_id)) - - ! Update the rotational velocity - x%dqdt(4:6, temp_id) = matmul(transpose(GlbRot_diff), x%dqdt(4:6, temp_id)) - - end do - end do -end subroutine - subroutine BD_PackOutputValues(p, y, Values) type(BD_ParameterType), intent(in) :: p type(BD_OutputType), intent(in) :: y diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index 90841199ba..e625edf1b7 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -623,10 +623,9 @@ END SUBROUTINE BD_TrapezoidalPointWeight !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates y%BldMotion%TranslationDisp, y%BldMotion%Orientation, y%BldMotion%TranslationVel, and !! y%BldMotion%RotationVel, which depend only on states (and indirectly, u%RootMotion), and parameters. -SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) +SUBROUTINE Set_BldMotion_NoAcc(p, x, OtherState, m, y) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BD_InputType), INTENT(IN ) :: u !< Inputs at t - in the FAST coordinate system (NOT BD) TYPE(BD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(BD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(BD_MiscVarType), INTENT(IN ) :: m !< misc/optimization variables @@ -657,8 +656,9 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) ! Calculate the translational displacement of each GLL node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos + matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & - y%BldMotion%Position(1:3,temp_id2) + y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos - y%BldMotion%Position(1:3,temp_id2) + & + matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) + !bjj: note differences here compared to BDrot_to_FASTdcm !adp: in BDrot_to_FASTdcm we are assuming that x%q(4:6,:) is zero because there is no rotatinoal displacement yet @@ -671,7 +671,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) CALL BD_CrvMatrixR(cc0,temp_R) ! returns temp_R (the transpose of the DCM orientation matrix) ! Store the DCM for the j'th node of the i'th element (in FAST coordinate system) - y%BldMotion%Orientation(1:3,1:3,temp_id2) = MATMUL(OtherState%GlbRot,TRANSPOSE(temp_R)) + y%BldMotion%Orientation(1:3,1:3,temp_id2) = TRANSPOSE(temp_R) ! Calculate the translation velocity and store in FAST coordinate system ! referenced against the DCM of the blade root at T=0. @@ -746,7 +746,7 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, OtherState, m, y) ! set positions and velocities (not accelerations) - call Set_BldMotion_NoAcc(p, u, x, OtherState, m, y) + call Set_BldMotion_NoAcc(p, x, OtherState, m, y) ! Only need this bit for dynamic cases IF ( p%analysis_type /= BD_STATIC_ANALYSIS ) THEN @@ -754,10 +754,6 @@ SUBROUTINE Set_BldMotion_Mesh(p, u, x, OtherState, m, y) ! now set the accelerations: ! The first node on the mesh is just the root location: - y%BldMotion%TranslationDisp(:,1) = u%RootMotion%TranslationDisp(:,1) - y%BldMotion%Orientation(:,:,1) = u%RootMotion%Orientation(:,:,1) - y%BldMotion%TranslationVel(:,1) = u%RootMotion%TranslationVel(:,1) - y%BldMotion%RotationVel(:,1) = u%RootMotion%RotationVel(:,1) y%BldMotion%TranslationAcc(:,1) = u%RootMotion%TranslationAcc(:,1) y%BldMotion%RotationAcc(:,1) = u%RootMotion%RotationAcc(:,1) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 033f8d80c1..9f9c0d5b37 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -145,11 +145,11 @@ MODULE BeamDyn_Types 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) [-] - REAL(R8Ki) , DIMENSION(1:3) :: GlbPos !< Position Vector between origins of Global (moving frame) and blade frames (BD coordinates) Follows the RootMotion mesh [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Rotation Tensor between Global (moving frame) and Blade frames (BD coordinates; transfers local to global). Follows the RootMotion mesh [-] - REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv !< CRV parameters of GlbRot. Follows the RootMotion mesh [-] + 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) [-] + REAL(R8Ki) , DIMENSION(1:3) :: GlbPos = 0.0_R8Ki !< Position Vector between origins of Global (moving frame) and blade frames (BD coordinates) Follows the RootMotion mesh [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Rotation Tensor between Global (moving frame) and Blade frames (BD coordinates; transfers local to global). Follows the RootMotion mesh [-] + REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv = 0.0_R8Ki !< CRV parameters of GlbRot. Follows the RootMotion mesh [-] END TYPE BD_OtherStateType ! ======================= ! ========= qpParam ======= @@ -168,15 +168,15 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: twN0 !< Initial Twist 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 = 0.0_R8Ki !< Gravitational acceleration [m/s^2] + REAL(R8Ki) , DIMENSION(1:3) :: gravity = 0.0_R8Ki !< Gravitational acceleration -- intertial frame!!! [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) :: 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(:), 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) [-] @@ -1152,41 +1152,25 @@ subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_DestroyInputFile' 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 - DstOtherStateData%GlbPos = SrcOtherStateData%GlbPos - DstOtherStateData%GlbRot = SrcOtherStateData%GlbRot - DstOtherStateData%Glb_crv = SrcOtherStateData%Glb_crv - END SUBROUTINE BD_CopyOtherState + 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 + 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 @@ -1393,274 +1377,15 @@ subroutine BD_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end subroutine - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%acc)) THEN - DEALLOCATE(OtherStateData%acc) -ENDIF -IF (ALLOCATED(OtherStateData%xcc)) THEN - DEALLOCATE(OtherStateData%xcc) -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 - 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 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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 - 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 - 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 - 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 - END SUBROUTINE BD_UnPackOtherState - - 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' -! +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 @@ -1695,463 +1420,14 @@ subroutine BD_DestroyContState(ContStateData, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg character(*), parameter :: RoutineName = 'BD_DestroyContState' 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 -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 + 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 @@ -2209,2134 +1485,13 @@ subroutine BD_UnPackContState(Buf, OutData) end if end subroutine - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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, DEALLOCATEpointers_local ) - 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, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN -DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - 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_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 - 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 - 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 - 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_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' -! +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 @@ -4449,6 +1604,9 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit + DstOtherStateData%GlbPos = SrcOtherStateData%GlbPos + DstOtherStateData%GlbRot = SrcOtherStateData%GlbRot + DstOtherStateData%Glb_crv = SrcOtherStateData%Glb_crv end subroutine subroutine BD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) @@ -4483,6 +1641,9 @@ subroutine BD_PackOtherState(Buf, Indata) end if call RegPack(Buf, InData%InitAcc) call RegPack(Buf, InData%RunQuasiStaticInit) + call RegPack(Buf, InData%GlbPos) + call RegPack(Buf, InData%GlbRot) + call RegPack(Buf, InData%Glb_crv) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4526,6 +1687,12 @@ subroutine BD_UnPackOtherState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RunQuasiStaticInit) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Glb_crv) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg) @@ -4743,9 +1910,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) 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) @@ -5232,9 +2396,6 @@ subroutine BD_PackParam(Buf, Indata) call RegPack(Buf, InData%blade_IN) call RegPack(Buf, InData%beta) call RegPack(Buf, InData%tol) - call RegPack(Buf, InData%GlbPos) - call RegPack(Buf, InData%GlbRot) - call RegPack(Buf, InData%Glb_crv) call RegPack(Buf, allocated(InData%QPtN)) if (allocated(InData%QPtN)) then call RegPackBounds(Buf, 1, lbound(InData%QPtN), ubound(InData%QPtN)) @@ -5529,12 +2690,6 @@ subroutine BD_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%tol) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GlbPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GlbRot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Glb_crv) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%QPtN)) deallocate(OutData%QPtN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 5da518d89e..ede4402152 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -265,11 +265,11 @@ logical function Failed() end function end subroutine -subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_TC) +subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: Mod !< Module data real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) integer(IntKi), intent(in) :: n_t_global !< Integer time step - real(R8Ki), optional, intent(in) :: x_TC(:) !< Tight coupling state array + real(R8Ki), intent(inout) :: x_TC(:) !< Tight coupling state array type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -302,25 +302,38 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, T, ErrStat, ErrMsg, x_T case (Module_BD) - ! If tight coupling states are supplied, transfer to module - if (present(x_TC)) then - call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) - call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) - call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) - end if + ! Transfer tight coupling states to module + call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) + call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) + call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) + + ! Update the global reference + call BD_UpdateGlobalRef(T%BD%Input(1, Mod%Ins), & + T%BD%p(Mod%Ins), & + T%BD%x(Mod%Ins, STATE_PRED), & + T%BD%OtherSt(Mod%Ins, STATE_PRED), & + ErrStat, ErrMsg); if (Failed()) return + + ! Transfer updated states to solver + call BD_PackStateValues(T%BD%p(Mod%Ins), & + T%BD%x(Mod%Ins, STATE_PRED), & + T%BD%m(Mod%Ins)%Vals%x) + call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%x, x_TC) case (Module_ED) - ! If tight coupling states are supplied, transfer to module - if (present(x_TC)) then - call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) - call XferGblToLoc1D(Mod%ixs, x_TC, T%ED%m%Vals%x) - call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(STATE_PRED)) - end if + ! Transfer tight coupling states to module + call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) + call XferGblToLoc1D(Mod%ixs, x_TC, T%ED%m%Vals%x) + call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(STATE_PRED)) - ! Update the azimuth angle in ED + ! Update the azimuth angle call ED_UpdateAzimuth(T%ED%p, T%ED%x(STATE_PRED), T%p_FAST%DT) + ! Transfer updated states to solver + call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) + call XferLocToGbl1D(Mod%ixs, T%ED%m%Vals%x, x_TC) + ! case (Module_ExtPtfm) ! case (Module_FEAM) case (Module_HD) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 9144362ecc..f4579400b9 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -792,89 +792,12 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) end do contains - function Failed() - logical :: Failed + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function end subroutine -subroutine UpdateBeamDynGlobalReference(p, m, Mod, T, ErrStat, ErrMsg) - type(TC_ParameterType), intent(in) :: p !< Parameters - type(TC_MiscVarType), intent(inout) :: m !< Misc variables - type(ModDataType), intent(in) :: Mod - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'UpdateBeamDynGlobalReference' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) - real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) - real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) - integer(IntKi) :: i, j, k - - ErrStat = ErrID_None - ErrMsg = '' - - associate (p_BD => T%BD%p(Mod%Ins), & - m_BD => T%BD%m(Mod%Ins), & - u_BD => T%BD%Input(1, Mod%Ins), & - x_BD => T%BD%x(Mod%Ins, STATE_PRED)) - - ! Save old global position, rotation, and WM (AO) - GlbPos_old = p_BD%GlbPos - GlbRot_old = p_BD%GlbRot - GlbWM_old = p_BD%Glb_crv - - ! Calculate new global position, rotation, and WM from root motion (BO) - GlbPos_new = u_BD%RootMotion%Position(:, 1) + & - u_BD%RootMotion%TranslationDisp(:, 1) - GlbRot_new = transpose(u_BD%RootMotion%Orientation(:, :, 1)) - GlbWM_new = wm_from_dcm(GlbRot_new) - - ! Update the module global values - p_BD%GlbPos = GlbPos_new - p_BD%GlbRot = GlbRot_new - p_BD%Glb_crv = GlbWM_new - - ! Calculate differences between old and new reference (BA = BO*AO^T) - GlbRot_diff = matmul(GlbRot_new, transpose(GlbRot_old)) - GlbWM_diff = wm_inv(wm_compose(GlbWM_new, wm_inv(GlbWM_old))) - - do i = 1, p_BD%elem_total - do j = 1, p_BD%nodes_per_elem - - ! State index - k = (i - 1)*(p_BD%nodes_per_elem - 1) + j - - ! Calculate displacements from new reference - x_BD%q(1:3, k) = matmul(transpose(GlbRot_new), & - matmul(GlbRot_old, p_BD%uuN0(1:3, j, i) + x_BD%q(1:3, k)) - & - matmul(GlbRot_new, p_BD%uuN0(1:3, j, i))) - - ! Update the node orientation rotation of the node - x_BD%q(4:6, k) = wm_compose(GlbWM_diff, x_BD%q(4:6, k)) - - ! Update the translational and rotational velocities - x_BD%dqdt(1:3, k) = matmul(GlbRot_diff, x_BD%dqdt(1:3, k)) - x_BD%dqdt(4:6, k) = matmul(GlbRot_diff, x_BD%dqdt(4:6, k)) - end do - end do - - ! Overwrite values at first node based on root motion - x_BD%q(:, 1) = 0.0_R8Ki - x_BD%dqdt(1:3, 1) = matmul(GlbRot_new, u_BD%RootMotion%TranslationVel(:, 1)) - x_BD%dqdt(4:6, 1) = matmul(GlbRot_new, u_BD%RootMotion%RotationVel(:, 1)) - - call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) - call XferLocToGbl1D(Mod%ixs, m_BD%Vals%x, m%xn) - - end associate - -end subroutine - subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrMsg) integer(IntKi), intent(in) :: n_t_global !< global time step real(DbKi), intent(in) :: t_initial !< Initial simulation time @@ -982,8 +905,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do i = 1, size(p%iModOpt2) call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, & - Turbine, ErrStat2, ErrMsg2, m%xn); if (Failed()) return + call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, m%xn, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return if (i < 2) then @@ -996,10 +919,14 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do i = 1, size(p%iModOpt1US) call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, & + call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, m%xn, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do + ! Populate state matrix with latest values from state array in case it + ! changed during FAST_UpdateStates calls + call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + ! Pack Option 1 inputs into u array call PackModuleInputs(Mods, p%iModOpt1, Turbine, u=m%un) @@ -1021,7 +948,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call FAST_CalcOutput(Mods(p%iModOpt1(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do - ! call PackModuleOutputs(Mods, p%iModOpt1, Turbine, m%y) !---------------------------------------------------------------------- ! If iteration limit reached, exit loop @@ -1032,19 +958,19 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM write (m%DebugUnit, *) "iterConv = ", iterConv write (m%DebugUnit, '(A,*(ES16.7))') " BD1-eps = ", pack(Turbine%BD%m(1)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-kappa = ", pack(Turbine%BD%m(1)%qp%kappa(1:3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3, :, 1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3, :, 1), .true.) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Nrrr = ", pack(Turbine%BD%m(1)%Nrrr(1:3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%p(1)%Glb_crv - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1)) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1)) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%p(1)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1))) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1))) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3, :, 1), .true.) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%OtherSt(1, STATE_PRED)%Glb_crv + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(transpose(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1))) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1)) + write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%OtherSt(1, STATE_PRED)%Glb_crv), wm_from_dcm(transpose(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1)))) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1))) write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1), .true.) + ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1), .true.) !---------------------------------------------------------------------- ! Update Jacobian @@ -1178,17 +1104,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Update states for next step !---------------------------------------------------------------------------- - ! Reset BeamDyn global reference and rescale BeamDyn states - ! Loop through tight coupling modules, if module is BeamDyn, update global ref - do i = 1, size(p%iModTC) - if (Mods(p%iModTC(i))%ID == Module_BD) then - call UpdateBeamDynGlobalReference(p, m, Mods(p%iModTC(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return - end if - end do - - ! Populate state matrix with latest values from state array - call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) - ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(p%iModAll) call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return From b5195fbead73829a5dce0708f063f67dc8779672 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 31 Aug 2023 17:06:37 +0000 Subject: [PATCH 25/61] Nearly there. Initialization needs work. --- modules/beamdyn/src/BeamDyn.f90 | 48 ++---- modules/beamdyn/src/BeamDyn_Subs.f90 | 3 - modules/openfast-library/src/FAST_Lin_TC.f90 | 1 + modules/openfast-library/src/Solver.f90 | 159 +++++++++---------- 4 files changed, 92 insertions(+), 119 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 13a36ccfd0..9ad3e273d6 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -2262,7 +2262,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ENDIF ! Calculate internal forces and moments - CALL BD_InternalForceMoment( x_tmp, OtherState, p, m ) + CALL BD_InternalForceMoment( x, OtherState, p, m ) ! Transfer the FirstNodeReaction forces to the output ReactionForce y%ReactionForce%Force(:,1) = MATMUL(OtherState%GlbRot,m%FirstNodeReactionLclForceMoment(1:3)) @@ -2270,7 +2270,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! set y%BldMotion fields: - CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, OtherState, m, y) + CALL Set_BldMotion_Mesh( p, m%u2, x, OtherState, m, y) !------------------------------------------------------- ! compute RootMxr and RootMyr for ServoDyn and @@ -2384,21 +2384,6 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return - ! dxdt%q contains angular velocities in terms of WM parameters, convert these to rad/s - ! do i = 2, size(dxdt%q, 2) - ! c = dxdt%q(4:6, i) - ! c0 = 2.0_R8Ki - dot_product(c, c) - ! vc = 2.0_R8Ki / (4.0_R8Ki - c0) - ! ct = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3]) - ! H = 0.0_R8Ki - ! do j = 1,3 - ! H(j,j) = 1.0_R8Ki - ! end do - ! cdot(:,1) = dxdt%dqdt(4:6, i) - ! H = vc*(H + vc/2.0_R8Ki*ct + vc/8.0_R8Ki*matmul(ct, ct)) - ! dxdt%dqdt(4:6, i) = pack(matmul(H, cdot), .true.) - ! end do - ! now set the derivatives of the continuous states. ! I am a little concerned that W-M parameter derivatives are in the wrong units, but I think this is the same issue that is in the GA2 solve (the opposite direction) dxdt%q = dxdt%dqdt @@ -4816,9 +4801,14 @@ SUBROUTINE BD_BoundaryGA2(x,p,u,OtherState, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - ! Root displacements -- no displacement relative to the root (reference frame attached to u%RootMotionMesh) - x%q(1:3,1) = 0.0_BDKi - x%q(4:6,1) = 0.0_BDKi + ! Root displacements + x%q(1:3,1) = u%RootMotion%TranslationDisp(1:3,1) + & + matmul(u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) + + ! Root rotations + CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1),p, OtherState, x%q(4:6,1), ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return ! Root velocities/angular velocities and accelerations/angular accelerations @@ -6767,7 +6757,7 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) GlbWM_new = OtherState%Glb_crv ! Calculate differences between old and new reference - GlbRot_diff = matmul(transpose(GlbRot_new), GlbRot_old) + GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) GlbWM_diff = wm_from_dcm(GlbRot_diff) do i = 1, p%elem_total @@ -6776,7 +6766,7 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. ! Calculate displacement in terms of new root motion mesh position - x%q(1:3, temp_id) = matmul(transpose(GlbRot_new),& + x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & GlbPos_old - GlbPos_new + & matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & matmul(GlbRot_new, p%uuN0(1:3, j, i))) @@ -6792,18 +6782,10 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) ! Update the rotational velocity x%dqdt(4:6, :) = matmul(GlbRot_diff, x%dqdt(4:6, :)) - ! Update translational acceleration - ! OtherState%acc(1:3, :) = matmul(GlbRot_diff, OtherState%acc(1:3, :)) - - ! Update rotational acceleration - ! OtherState%acc(4:6, :) = matmul(GlbRot_diff, OtherState%acc(4:6, :)) - ! Root node is always aligned with root motion mesh - ! x%q(:, 1) = 0.0_R8Ki - ! x%dqdt(1:3, 1) = matmul(u%RootMotion%TranslationVel(:, 1), GlbRot_new) - ! x%dqdt(4:6, 1) = matmul(u%RootMotion%RotationVel(:, 1), GlbRot_new) - ! OtherState%acc(1:3, 1) = matmul(u%RootMotion%TranslationAcc(:, 1), GlbRot_new) - ! OtherState%acc(4:6, 1) = matmul(u%RootMotion%RotationAcc(:, 1), GlbRot_new) + x%q(:, 1) = 0.0_R8Ki + x%dqdt(1:3, 1) = matmul(u%RootMotion%TranslationVel(:, 1), GlbRot_new) + x%dqdt(4:6, 1) = matmul(u%RootMotion%RotationVel(:, 1), GlbRot_new) end subroutine diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index e625edf1b7..b601839a03 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -686,9 +686,6 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, OtherState, m, y) CASE (BD_MESH_QP) - y%BldMotion%TranslationVel(:,1) = u%RootMotion%TranslationVel(:,1) - y%BldMotion%RotationVel(:,1) = u%RootMotion%RotationVel(:,1) - DO i=1,p%elem_total DO j=1,p%nqp temp_id2 = (i-1)*p%nqp + j + p%qp_indx_offset ! Index to a node within element i diff --git a/modules/openfast-library/src/FAST_Lin_TC.f90 b/modules/openfast-library/src/FAST_Lin_TC.f90 index 5cb0f73216..9ec6f4abb6 100644 --- a/modules/openfast-library/src/FAST_Lin_TC.f90 +++ b/modules/openfast-library/src/FAST_Lin_TC.f90 @@ -24,6 +24,7 @@ MODULE FAST_Linear ! USE FAST_Solver ! I mostly just want the modules that are inherited from this module, not the routines in it USE FAST_ModTypes + USE NWTC_LAPACK USE AeroDyn USE AeroDyn14 diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index f4579400b9..edde9705de 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -345,7 +345,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) m%dUdy = 0.0_R8Ki !---------------------------------------------------------------------------- - ! Allocate Jacobian matrix, RHS, and Delta + ! Allocate solver Jacobian matrix, RHS, and Delta !---------------------------------------------------------------------------- ! Initialize size of system @@ -372,6 +372,11 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) call AllocAry(m%IPIV, NumJac, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return m%Jac = 0.0_R8Ki + ! Initialize iterations and steps until Jacobian is calculated to zero + ! so it will be calculated in first step + m%IterUntilUJac = 0 + m%StepsUntilUJac = 0 + !---------------------------------------------------------------------------- ! Calculate generalized alpha parameters !---------------------------------------------------------------------------- @@ -393,55 +398,55 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! munit = -1 - call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return - call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return - - write (m%DebugUnit, *) "NumX = ", NumX - write (m%DebugUnit, *) "NumU = ", NumU - write (m%DebugUnit, *) "NumY = ", NumY - write (m%DebugUnit, *) "NumJac = ", NumJac - write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 - write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT - write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 - write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL - write (m%DebugUnit, '(A,*(I4))') " p%iX2Tight = ", p%iX2Tight - write (m%DebugUnit, '(A,*(I4))') " p%iX1Tight = ", p%iX1Tight - write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight - write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 - write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight - write (m%DebugUnit, '(A,*(I4))') " p%iyOpt1 = ", p%iyOpt1 - write (m%DebugUnit, *) "shape(m%dYdx) = ", shape(m%dYdx) - write (m%DebugUnit, *) "shape(m%dYdu) = ", shape(m%dYdu) - write (m%DebugUnit, *) "shape(m%dXdx) = ", shape(m%dXdx) - write (m%DebugUnit, *) "shape(m%dXdu) = ", shape(m%dXdu) - write (m%DebugUnit, *) "shape(m%dUdu) = ", shape(m%dUdu) - write (m%DebugUnit, *) "shape(m%dUdy) = ", shape(m%dUdy) - - do i = 1, size(Mods) - write (m%DebugUnit, *) "Module = ", Mods(i)%Abbr - write (m%DebugUnit, *) "ModuleID = ", Mods(i)%ID - do j = 1, size(Mods(i)%Vars%x) - if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle - write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & - " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" - write (m%DebugUnit, '(A,*(I4))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc - write (m%DebugUnit, '(A,*(I4))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol - end do - do j = 1, size(Mods(i)%Vars%u) - if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle - write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & - " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" - write (m%DebugUnit, '(A,*(I4))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc - write (m%DebugUnit, '(A,*(I4))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol - end do - do j = 1, size(Mods(i)%Vars%y) - if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle - write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & - " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" - write (m%DebugUnit, '(A,*(I4))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc - write (m%DebugUnit, '(A,*(I4))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol - end do - end do + ! call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return + ! call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return + + ! write (m%DebugUnit, *) "NumX = ", NumX + ! write (m%DebugUnit, *) "NumU = ", NumU + ! write (m%DebugUnit, *) "NumY = ", NumY + ! write (m%DebugUnit, *) "NumJac = ", NumJac + ! write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 + ! write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT + ! write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 + ! write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL + ! write (m%DebugUnit, '(A,*(I4))') " p%iX2Tight = ", p%iX2Tight + ! write (m%DebugUnit, '(A,*(I4))') " p%iX1Tight = ", p%iX1Tight + ! write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight + ! write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 + ! write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight + ! write (m%DebugUnit, '(A,*(I4))') " p%iyOpt1 = ", p%iyOpt1 + ! write (m%DebugUnit, *) "shape(m%dYdx) = ", shape(m%dYdx) + ! write (m%DebugUnit, *) "shape(m%dYdu) = ", shape(m%dYdu) + ! write (m%DebugUnit, *) "shape(m%dXdx) = ", shape(m%dXdx) + ! write (m%DebugUnit, *) "shape(m%dXdu) = ", shape(m%dXdu) + ! write (m%DebugUnit, *) "shape(m%dUdu) = ", shape(m%dUdu) + ! write (m%DebugUnit, *) "shape(m%dUdy) = ", shape(m%dUdy) + + ! do i = 1, size(Mods) + ! write (m%DebugUnit, *) "Module = ", Mods(i)%Abbr + ! write (m%DebugUnit, *) "ModuleID = ", Mods(i)%ID + ! do j = 1, size(Mods(i)%Vars%x) + ! if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle + ! write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & + ! " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" + ! write (m%DebugUnit, '(A,*(I4))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc + ! write (m%DebugUnit, '(A,*(I4))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol + ! end do + ! do j = 1, size(Mods(i)%Vars%u) + ! if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle + ! write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & + ! " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" + ! write (m%DebugUnit, '(A,*(I4))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc + ! write (m%DebugUnit, '(A,*(I4))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol + ! end do + ! do j = 1, size(Mods(i)%Vars%y) + ! if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle + ! write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & + ! " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" + ! write (m%DebugUnit, '(A,*(I4))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc + ! write (m%DebugUnit, '(A,*(I4))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol + ! end do + ! end do contains function Failed() @@ -836,7 +841,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 - write (m%DebugUnit, *) "step = ", n_t_global_next + ! write (m%DebugUnit, *) "step = ", n_t_global_next !---------------------------------------------------------------------------- ! Extrapolate/interpolate inputs for all modules @@ -892,7 +897,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM iterCorr = 0 do while (iterCorr <= p%NumCrctn) - write (m%DebugUnit, *) "iterCorr = ", iterCorr + ! write (m%DebugUnit, *) "iterCorr = ", iterCorr ! Copy state for correction step m%qn = m%q @@ -901,6 +906,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Reset mappings updated flags m%Mappings%Updated = .false. + !------------------------------------------------------------------------- + ! Option 2 Solve + !------------------------------------------------------------------------- + ! Loop through Option 2 modules do i = 1, size(p%iModOpt2) call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & @@ -915,6 +924,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end if end do + !------------------------------------------------------------------------- + ! Option 1 Solve + !------------------------------------------------------------------------- + ! Get inputs and update states for Option 1 modules not in Option 2 do i = 1, size(p%iModOpt1US) call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & @@ -955,32 +968,14 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM if (iterConv >= p%MaxConvIter) exit - write (m%DebugUnit, *) "iterConv = ", iterConv - - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-eps = ", pack(Turbine%BD%m(1)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-eps = ", pack(Turbine%BD%m(2)%qp%E1(1:3, :, 1) - Turbine%BD%m(1)%qp%RR0(1:3, 3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-kappa = ", pack(Turbine%BD%m(1)%qp%kappa(1:3, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-kappa = ", pack(Turbine%BD%m(2)%qp%kappa(1:3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Nrrr = ", pack(Turbine%BD%m(1)%Nrrr(1:3, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Nrrr = ", pack(Turbine%BD%m(2)%Nrrr(1:3, :, 1), .true.) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-Glb_crv = ", Turbine%BD%OtherSt(1, STATE_PRED)%Glb_crv - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-Glb_crv = ", Turbine%BD%p(2)%Glb_crv - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot = ", wm_from_dcm(transpose(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1))) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot = ", wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1)) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RR = ", wm_compose(wm_inv(Turbine%BD%OtherSt(1, STATE_PRED)%Glb_crv), wm_from_dcm(transpose(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1)))) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RR = ", wm_compose(wm_inv(Turbine%BD%p(2)%Glb_crv), wm_from_dcm(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1))) - write (m%DebugUnit, '(A,*(ES16.7))') " BD1-RRoot-dcm = ", pack(Turbine%BD%Input(1, 1)%RootMotion%Orientation(:, :, 1), .true.) - ! write (m%DebugUnit, '(A,*(ES16.7))') " BD2-RRoot-dcm = ", pack(Turbine%BD%Input(1, 2)%RootMotion%Orientation(:, :, 1), .true.) - !---------------------------------------------------------------------- ! Update Jacobian !---------------------------------------------------------------------- ! If number of iterations or steps until Jacobian is to be updated - ! is zero or less, then rebuild the Jacobian. Note: Solver_BuildJacobian - ! resets these counters. + ! is zero or less, or first solution step, then rebuild the Jacobian. + ! Note: Solver_BuildJacobian resets these counters. if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0) .or. (n_t_global_next == 1)) then - call Solver_BuildJacobian(p, m, Mods, t_global_next, n_t_global_next*100 + iterConv, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end if @@ -1020,8 +1015,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Solve for state and input perturbations !---------------------------------------------------------------------- - write (m%DebugUnit, '(A,*(ES16.7))') " XB = ", m%XB - ! Solve Jacobian and RHS call LAPACK_getrs('N', size(m%Jac, 1), m%Jac, m%IPIV, m%XB, ErrStat2, ErrMsg2); if (Failed()) return @@ -1031,13 +1024,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) - write (m%DebugUnit, '(A,*(ES16.7))') " y = ", m%y - write (m%DebugUnit, '(A,*(ES16.7))') " u = ", m%un - write (m%DebugUnit, '(A,*(ES16.7))') " u_tmp = ", m%u_tmp - write (m%DebugUnit, '(A,*(ES16.7))') " U = ", m%UDiff - write (m%DebugUnit, '(A,*(ES16.7))') " x = ", m%xn - write (m%DebugUnit, *) "delta_norm = ", delta_norm - if (delta_norm < p%ConvTol) exit ! Remove conditioning @@ -1086,8 +1072,15 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer updated states and inputs to relevant modules !---------------------------------------------------------------------- - write (m%DebugUnit, '(A,*(ES16.7))') " du = ", m%du - write (m%DebugUnit, '(A,*(ES16.7))') " dx = ", m%dx + ! write (m%DebugUnit, *) "iterConv = ", iterConv + ! write (m%DebugUnit, '(A,*(ES16.7))') " y = ", m%y + ! write (m%DebugUnit, '(A,*(ES16.7))') " u = ", m%un + ! write (m%DebugUnit, '(A,*(ES16.7))') " u_tmp = ", m%u_tmp + ! write (m%DebugUnit, '(A,*(ES16.7))') " U = ", m%UDiff + ! write (m%DebugUnit, '(A,*(ES16.7))') " x = ", m%xn + ! write (m%DebugUnit, *) "delta_norm = ", delta_norm + ! write (m%DebugUnit, '(A,*(ES16.7))') " du = ", m%du + ! write (m%DebugUnit, '(A,*(ES16.7))') " dx = ", m%dx end do From 5e26dd21f0f48fa4f8568a23e618d7f23dfb5f4f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 6 Sep 2023 17:57:06 +0000 Subject: [PATCH 26/61] Commit everything --- modules/beamdyn/src/BeamDyn.f90 | 78 +- modules/elastodyn/src/ElastoDyn.f90 | 31 +- modules/nwtc-library/src/ModVar.f90 | 50 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 85 +- .../src/Registry_NWTC_Library.txt | 27 +- .../src/Registry_NWTC_Library_base.txt | 27 +- modules/openfast-library/src/FAST_Eval.f90 | 58 +- .../openfast-library/src/FAST_Registry.txt | 23 +- modules/openfast-library/src/FAST_Types.f90 | 457 ++----- modules/openfast-library/src/Solver.f90 | 1050 +++++++++-------- 10 files changed, 825 insertions(+), 1061 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 9ad3e273d6..409754871a 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -408,7 +408,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) call AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return InitOut%DerivOrder_x = 2 do i = 1, size(p%Vars%x) - do j = 1, p%Vars%x(i)%NumLin + do j = 1, p%Vars%x(i)%Num InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 end do @@ -419,7 +419,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, size(p%Vars%u) - do j = 1, p%Vars%u(i)%NumLin + do j = 1, p%Vars%u(i)%Num InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 @@ -430,7 +430,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) call AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return do i = 1, size(p%Vars%y) - do j = 1, p%Vars%y(i)%NumLin + do j = 1, p%Vars%y(i)%Num InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 end do @@ -2262,7 +2262,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ENDIF ! Calculate internal forces and moments - CALL BD_InternalForceMoment( x, OtherState, p, m ) + CALL BD_InternalForceMoment( x_tmp, OtherState, p, m ) ! Transfer the FirstNodeReaction forces to the output ReactionForce y%ReactionForce%Force(:,1) = MATMUL(OtherState%GlbRot,m%FirstNodeReactionLclForceMoment(1:3)) @@ -2270,7 +2270,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, ! set y%BldMotion fields: - CALL Set_BldMotion_Mesh( p, m%u2, x, OtherState, m, y) + CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, OtherState, m, y) !------------------------------------------------------- ! compute RootMxr and RootMyr for ServoDyn and @@ -6039,11 +6039,11 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Loop through input variables do i = 1, size(p%Vars%u) - ! If variable is not for linearization or is extended, skip - if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + ! If variable is for extended linearization, skip + if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%u(i)%NumLin + do j = 1,p%Vars%u(i)%Num ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) @@ -6081,7 +6081,7 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%u(i)%NumLin + do j = 1,p%Vars%u(i)%Num ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) @@ -6302,11 +6302,11 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ! Loop through state variables do i = 1,size(p%Vars%x) - ! If variable is not for linearization or is extended, skip - if (iand(p%Vars%x(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + ! If variable is for extended linearization, skip + if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%x(i)%NumLin + do j = 1,p%Vars%x(i)%Num ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) @@ -6344,7 +6344,7 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%x(i)%Size + do j = 1,p%Vars%x(i)%Num ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) @@ -6730,12 +6730,11 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_UpdateGlobalRef' integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(ErrMsgLen) :: ErrMsg2 real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) - real(R8Ki) :: pos(3), rot(3), trans_vel(3), rot_vel(3), uuN0(3) - integer(IntKi) :: i, j, temp_id, temp_id2 + integer(IntKi) :: i, j, temp_id ErrStat = ErrID_None ErrMsg = "" @@ -6746,33 +6745,36 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) GlbWM_old = OtherState%Glb_crv ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) - OtherState%GlbPos = u%RootMotion%Position(:, 1) + & - u%RootMotion%TranslationDisp(:, 1) - OtherState%GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) - OtherState%Glb_crv = wm_from_dcm(OtherState%GlbRot) + GlbPos_new = u%RootMotion%Position(:, 1) + & + u%RootMotion%TranslationDisp(:, 1) + GlbRot_new = transpose(u%RootMotion%Orientation(:, :, 1)) + GlbWM_new = wm_from_dcm(GlbRot_new) + GlbRot_new = wm_to_dcm(GlbWM_new) ! Save new global position, rotation, and WM - GlbPos_new = OtherState%GlbPos - GlbRot_new = OtherState%GlbRot - GlbWM_new = OtherState%Glb_crv + OtherState%GlbPos = GlbPos_new + OtherState%GlbRot = GlbRot_new + OtherState%Glb_crv = GlbWM_new ! Calculate differences between old and new reference - GlbRot_diff = matmul(transpose(GlbRot_old), GlbRot_new) - GlbWM_diff = wm_from_dcm(GlbRot_diff) + GlbWM_diff = wm_compose(wm_inv(GlbWM_new), GlbWM_old) + GlbRot_diff = wm_to_dcm(GlbWM_diff) + ! Loop through elements and nodes do i = 1, p%elem_total do j = 1, p%nodes_per_elem - temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! The last node of the first element is used as the first node in the second element. + ! The last node of the first element is used as the first node in the second element. + temp_id = (i - 1)*(p%nodes_per_elem - 1) + j ! Calculate displacement in terms of new root motion mesh position - x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & - GlbPos_old - GlbPos_new + & - matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & - matmul(GlbRot_new, p%uuN0(1:3, j, i))) - - ! Update the node orientation - x%q(4:6, temp_id) = wm_compose(GlbWM_diff, x%q(4:6, temp_id)) + x%q(1:3, temp_id) = matmul(transpose(GlbRot_new), & + GlbPos_old - GlbPos_new + & + matmul(GlbRot_old, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + matmul(GlbRot_new, p%uuN0(1:3, j, i))) + + ! Update the node orientation rotation of the node + call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1R2) end do end do @@ -6781,6 +6783,16 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) ! Update the rotational velocity x%dqdt(4:6, :) = matmul(GlbRot_diff, x%dqdt(4:6, :)) + + ! Update the translational and rotational acceleration for GA2 algorithm + OtherState%acc(1:3, 1) = matmul(u%RootMotion%TranslationAcc(:, 1), GlbRot_new) + OtherState%acc(4:6, 1) = matmul(u%RootMotion%RotationAcc(:, 1), GlbRot_new) + OtherState%acc(1:3, 2:) = matmul(GlbRot_diff, OtherState%acc(1:3, 2:)) + OtherState%acc(4:6, 2:) = matmul(GlbRot_diff, OtherState%acc(4:6, 2:)) + + ! Update the translational and rotational algorithm acceleration for GA2 algorithm + OtherState%xcc(1:3, :) = matmul(GlbRot_diff, OtherState%xcc(1:3, :)) + OtherState%xcc(4:6, :) = matmul(GlbRot_diff, OtherState%xcc(4:6, :)) ! Root node is always aligned with root motion mesh x%q(:, 1) = 0.0_R8Ki diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 4c48030e93..ac9102029f 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -587,9 +587,6 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, call MV_AddVar(p%Vars%u, "BlPitchComC", VF_Scalar, Flags=VF_Ext, & LinNames=['Extended input: collective blade-pitch command, rad']) p%iBlPitchComCVar = size(p%Vars%u) - ! call MV_AddVar(p%Vars%u, "TwrAddedMass", VF_Scalar, Num=6*6*p%TwrNodes, Flags=VF_NoLin) - ! call MV_AddVar(p%Vars%u, "PtfmAddedMass", VF_Scalar, Num=6*6, Flags=VF_NoLin) - ! call MV_AddVar(p%Vars%u, "HSSBrTrqC", VF_Scalar, Num=1, Flags=VF_NoLin) ! Set minimum input perturbations do i = 1,size(p%Vars%u) @@ -650,7 +647,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, if (ErrStat >= AbortErrLev) return InitOut%DerivOrder_x = 2 do i = 1, size(p%Vars%x) - do j = 1, p%Vars%x(i)%NumLin + do j = 1, p%Vars%x(i)%Num InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 end do @@ -662,7 +659,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return if (ErrStat >= AbortErrLev) return do i = 1, size(p%Vars%u) - do j = 1, p%Vars%u(i)%NumLin + do j = 1, p%Vars%u(i)%Num InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 @@ -674,7 +671,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, CALL AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return if (ErrStat >= AbortErrLev) return do i = 1, size(p%Vars%y) - do j = 1, p%Vars%y(i)%NumLin + do j = 1, p%Vars%y(i)%Num InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 end do @@ -10602,11 +10599,11 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Loop through input variables do i = 1, size(p%Vars%u) - ! If variable is not for linearization or is extended, skip - if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + ! If extended linearization variable, skip + if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%u(i)%NumLin + do j = 1,p%Vars%u(i)%Num ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) @@ -10643,10 +10640,10 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM do i = 1,size(p%Vars%u) ! If extended linearization variable, skip - if (iand(p%Vars%u(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%u(i)%NumLin + do j = 1,p%Vars%u(i)%Num ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) @@ -10761,11 +10758,11 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through state variables do i = 1,size(p%Vars%x) - ! If variable is not for linearization or is extended, skip - if (iand(p%Vars%x(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + ! If extended linearization variable, skip + if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%x(i)%NumLin + do j = 1,p%Vars%x(i)%Num ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) @@ -10798,11 +10795,11 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through state variables do i = 1,size(p%Vars%x) - ! If no-lin or extended linearization variable, skip - if (iand(p%Vars%x(i)%Flags, VF_NoLin+VF_Ext) > 0) cycle + ! If extended linearization variable, skip + if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle ! Loop through number of linearization perturbations in variable - do j = 1,p%Vars%x(i)%NumLin + do j = 1,p%Vars%x(i)%Num ! Calculate positive perturbation and resulting continuous state derivatives call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 1811adba53..a3edf351a8 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -100,27 +100,30 @@ subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) ErrMsg = '' ! Initialize state variables + if (.not. allocated(Vars%x)) allocate(Vars%x(0)) StartIndex = 1 do i = 1, size(Vars%x) call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize input variables + if (.not. allocated(Vars%x)) allocate(Vars%u(0)) StartIndex = 1 do i = 1, size(Vars%u) call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize output variables + if (.not. allocated(Vars%x)) allocate(Vars%y(0)) StartIndex = 1 do i = 1, size(Vars%y) call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do - ! Calculate number of variables in group (exclude non linearization vars) - Vars%Nx = sum(Vars%x%Size, iand(Vars%x%Flags, VF_NoLin) == 0) - Vars%Nu = sum(Vars%u%Size, iand(Vars%u%Flags, VF_NoLin) == 0) - Vars%Ny = sum(Vars%y%Size, iand(Vars%y%Flags, VF_NoLin) == 0) + ! Calculate number of state, input, and output variables + Vars%Nx = sum(Vars%x%Num) + Vars%Nu = sum(Vars%u%Num) + Vars%Ny = sum(Vars%y%Num) ! Allocate state, input, and output values call AllocAry(Vals%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return @@ -178,12 +181,6 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' - !---------------------------------------------------------------------------- - ! Basic Variable - !---------------------------------------------------------------------------- - - Var%NumLin = Var%Size - !---------------------------------------------------------------------------- ! Mesh !---------------------------------------------------------------------------- @@ -192,11 +189,10 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) if (iand(Var%Flags, VF_Mesh) > 0) then ! Size is the number of nodes in a mesh - Var%Nodes = Var%Size + Var%Nodes = Var%Num - ! Number of linearization values - Var%NumLin = Var%Nodes*3 - Var%Size = Var%Nodes*3 + ! Number of values + Var%Num = Var%Nodes*3 ! If linearization requested if (Linearize) then @@ -232,20 +228,18 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) end if !---------------------------------------------------------------------------- - ! No Linearization + ! Linearization !---------------------------------------------------------------------------- - if (iand(Var%Flags, VF_NoLin) > 0) then ! No Linearization + if (Linearize) then - ! Number of linearization values is zero if NoLin flag is set - Var%NumLin = 0 - - else if (Linearize) then - - ! If insufficient linearization names, return error - if (size(Var%LinNames) < Var%NumLin) then + ! If incorrect number of linearization names, return error + if (size(Var%LinNames) < Var%Num) then call SetErrStat(ErrID_Fatal, "insufficient LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) return + else if (size(Var%LinNames) > Var%Num) then + call SetErrStat(ErrID_Fatal, "excessive LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return end if end if @@ -254,11 +248,11 @@ subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! Initialize local index - call AllocAry(Var%iLoc, Var%Size, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return - Var%iLoc = [(index + i, i=0, Var%Size - 1)] + call AllocAry(Var%iLoc, Var%Num, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return + Var%iLoc = [(index + i, i=0, Var%Num - 1)] ! Update index based on variable size - index = index + Var%Size + index = index + Var%Num contains function Failed() @@ -613,7 +607,7 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, Perturb, LinNames, A Var = ModVarType(Name=Name, Field=Field) ! Set optional values - if (present(Num)) Var%Size = Num + if (present(Num)) Var%Num = Num if (present(Flags)) Var%Flags = Flags if (present(iUsr)) Var%iUsr = iUsr if (present(Perturb)) Var%Perturb = Perturb @@ -898,6 +892,7 @@ pure function wm_to_xyz(c) result(xyz) n = c/m phi = 4.0_R8Ki*atan(m/4.0_R8Ki) xyz = phi*n + ! xyz = c end function pure function wm_from_xyz(xyz) result(c) @@ -910,6 +905,7 @@ pure function wm_from_xyz(xyz) result(c) end if n = xyz / phi c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n + ! c = xyz end function ! pure function wm_from_dcm(R) result(c) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index dea8918652..f403cb8819 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -112,17 +112,15 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: ModVarType character(VarNameLen) :: Name !< [-] INTEGER(IntKi) :: Field = 0 !< [-] - INTEGER(IntKi) :: Cat = 0 !< [-] INTEGER(IntKi) :: Nodes = 1 !< [-] - INTEGER(IntKi) :: Size = 1 !< [-] + INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] - INTEGER(IntKi) :: NumLin = 0 !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUsr !< user defined indices for variable [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblSol !< indices in global arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblLin !< indices in global arrays [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iy !< indices of output to sum for input [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblSol !< indices in global solver arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblLin !< indices in global linearization arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< q matrix row index [-] REAL(R8Ki) :: Perturb = 0 !< perturbation [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType @@ -131,9 +129,9 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: ModVarsType INTEGER(IntKi) :: ModNum = 0 !< [-] character(6) :: ModAbbr !< [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< [-] - TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] INTEGER(IntKi) :: Nx = 0_IntKi !< [-] INTEGER(IntKi) :: Nu = 0_IntKi !< [-] INTEGER(IntKi) :: Ny = 0_IntKi !< [-] @@ -160,12 +158,11 @@ MODULE NWTC_Library_Types ! ========= ModDataType ======= TYPE, PUBLIC :: ModDataType INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] - INTEGER(IntKi) :: ID = 0 !< [-] - character(ChanLen) :: Abbr !< [-] - INTEGER(IntKi) :: Ins = 0 !< [-] - REAL(R8Ki) :: DT = 0 !< [-] - INTEGER(IntKi) :: SubSteps = 0 !< [-] - INTEGER(IntKi) :: SolveOption = 0 !< [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] @@ -753,19 +750,17 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' ErrStat = ErrID_None ErrMsg = '' DstModVarTypeData%Name = SrcModVarTypeData%Name DstModVarTypeData%Field = SrcModVarTypeData%Field - DstModVarTypeData%Cat = SrcModVarTypeData%Cat DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes - DstModVarTypeData%Size = SrcModVarTypeData%Size + DstModVarTypeData%Num = SrcModVarTypeData%Num DstModVarTypeData%Flags = SrcModVarTypeData%Flags DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder - DstModVarTypeData%NumLin = SrcModVarTypeData%NumLin if (allocated(SrcModVarTypeData%iUsr)) then LB(1:1) = lbound(SrcModVarTypeData%iUsr) UB(1:1) = ubound(SrcModVarTypeData%iUsr) @@ -814,17 +809,17 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr end if DstModVarTypeData%iGblLin = SrcModVarTypeData%iGblLin end if - if (allocated(SrcModVarTypeData%iy)) then - LB(1:2) = lbound(SrcModVarTypeData%iy) - UB(1:2) = ubound(SrcModVarTypeData%iy) - if (.not. allocated(DstModVarTypeData%iy)) then - allocate(DstModVarTypeData%iy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcModVarTypeData%iq)) then + LB(1:1) = lbound(SrcModVarTypeData%iq) + UB(1:1) = ubound(SrcModVarTypeData%iq) + if (.not. allocated(DstModVarTypeData%iq)) then + allocate(DstModVarTypeData%iq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iy.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iq.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModVarTypeData%iy = SrcModVarTypeData%iy + DstModVarTypeData%iq = SrcModVarTypeData%iq end if DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb if (allocated(SrcModVarTypeData%LinNames)) then @@ -860,8 +855,8 @@ subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) if (allocated(ModVarTypeData%iGblLin)) then deallocate(ModVarTypeData%iGblLin) end if - if (allocated(ModVarTypeData%iy)) then - deallocate(ModVarTypeData%iy) + if (allocated(ModVarTypeData%iq)) then + deallocate(ModVarTypeData%iq) end if if (allocated(ModVarTypeData%LinNames)) then deallocate(ModVarTypeData%LinNames) @@ -875,12 +870,10 @@ subroutine NWTC_Library_PackModVarType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Name) call RegPack(Buf, InData%Field) - call RegPack(Buf, InData%Cat) call RegPack(Buf, InData%Nodes) - call RegPack(Buf, InData%Size) + call RegPack(Buf, InData%Num) call RegPack(Buf, InData%Flags) call RegPack(Buf, InData%DerivOrder) - call RegPack(Buf, InData%NumLin) call RegPack(Buf, allocated(InData%iUsr)) if (allocated(InData%iUsr)) then call RegPackBounds(Buf, 1, lbound(InData%iUsr), ubound(InData%iUsr)) @@ -901,10 +894,10 @@ subroutine NWTC_Library_PackModVarType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%iGblLin), ubound(InData%iGblLin)) call RegPack(Buf, InData%iGblLin) end if - call RegPack(Buf, allocated(InData%iy)) - if (allocated(InData%iy)) then - call RegPackBounds(Buf, 2, lbound(InData%iy), ubound(InData%iy)) - call RegPack(Buf, InData%iy) + call RegPack(Buf, allocated(InData%iq)) + if (allocated(InData%iq)) then + call RegPackBounds(Buf, 1, lbound(InData%iq), ubound(InData%iq)) + call RegPack(Buf, InData%iq) end if call RegPack(Buf, InData%Perturb) call RegPack(Buf, allocated(InData%LinNames)) @@ -919,7 +912,7 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ModVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarType' - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -927,18 +920,14 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Field) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cat) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Nodes) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Size) + call RegUnpack(Buf, OutData%Num) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Flags) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DerivOrder) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumLin) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%iUsr)) deallocate(OutData%iUsr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -995,18 +984,18 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) call RegUnpack(Buf, OutData%iGblLin) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iy)) deallocate(OutData%iy) + if (allocated(OutData%iq)) deallocate(OutData%iq) 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%iy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%iq(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iy) + call RegUnpack(Buf, OutData%iq) if (RegCheckErr(Buf, RoutineName)) return end if call RegUnpack(Buf, OutData%Perturb) @@ -1777,7 +1766,6 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, DstModDataTypeData%Ins = SrcModDataTypeData%Ins DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps - DstModDataTypeData%SolveOption = SrcModDataTypeData%SolveOption if (allocated(SrcModDataTypeData%ixs)) then LB(1:2) = lbound(SrcModDataTypeData%ixs) UB(1:2) = ubound(SrcModDataTypeData%ixs) @@ -1850,7 +1838,6 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) call RegPack(Buf, InData%Ins) call RegPack(Buf, InData%DT) call RegPack(Buf, InData%SubSteps) - call RegPack(Buf, InData%SolveOption) call RegPack(Buf, allocated(InData%ixs)) if (allocated(InData%ixs)) then call RegPackBounds(Buf, 2, lbound(InData%ixs), ubound(InData%ixs)) @@ -1898,8 +1885,6 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SubSteps) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SolveOption) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%ixs)) deallocate(OutData%ixs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 3dda455bb6..a632d114ed 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -67,25 +67,23 @@ param ^ - IntKi VC_Option2 - 3 - typedef ^ ModVarType character(VarNameLen) Name - - - "" - typedef ^ ^ IntKi Field - 0 - "" - -typedef ^ ^ IntKi Cat - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - -typedef ^ ^ IntKi Size - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi NumLin - 0 - "" - typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iGblSol : - - "indices in global arrays" - -typedef ^ ^ IntKi iGblLin : - - "indices in global arrays" - -typedef ^ ^ IntKi iy :: - - "indices of output to sum for input" - +typedef ^ ^ IntKi iGblSol : - - "indices in global solver arrays" - +typedef ^ ^ IntKi iGblLin : - - "indices in global linearization arrays" - +typedef ^ ^ IntKi iq : - - "q matrix row index" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi ModNum - 0 - "" - typedef ^ ^ character(6) ModAbbr - - - "" - -typedef ^ ^ ModVarType x : - - "" - -typedef ^ ^ ModVarType u : - - "" - -typedef ^ ^ ModVarType y : - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - typedef ^ ^ IntKi Nx - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - @@ -106,12 +104,11 @@ typedef ^ ^ R8Ki dYdu :: - - typedef ^ ^ R8Ki dXdu :: - - "" - typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - -typedef ^ ^ IntKi ID - 0 - "" - -typedef ^ ^ character(ChanLen) Abbr - - - "" - -typedef ^ ^ IntKi Ins - 0 - "" - -typedef ^ ^ R8Ki DT - 0 - "" - -typedef ^ ^ IntKi SubSteps - 0 - "" - -typedef ^ ^ IntKi SolveOption - 0 - "" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 0f5721a0fc..cc4c3dc347 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -67,25 +67,23 @@ param ^ - IntKi VC_Option2 - 3 - typedef ^ ModVarType character(VarNameLen) Name - - - "" - typedef ^ ^ IntKi Field - 0 - "" - -typedef ^ ^ IntKi Cat - 0 - "" - typedef ^ ^ IntKi Nodes - 1 - "" - -typedef ^ ^ IntKi Size - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi NumLin - 0 - "" - typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iGblSol : - - "indices in global arrays" - -typedef ^ ^ IntKi iGblLin : - - "indices in global arrays" - -typedef ^ ^ IntKi iy :: - - "indices of output to sum for input" - +typedef ^ ^ IntKi iGblSol : - - "indices in global solver arrays" - +typedef ^ ^ IntKi iGblLin : - - "indices in global linearization arrays" - +typedef ^ ^ IntKi iq : - - "q matrix row index" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi ModNum - 0 - "" - typedef ^ ^ character(6) ModAbbr - - - "" - -typedef ^ ^ ModVarType x : - - "" - -typedef ^ ^ ModVarType u : - - "" - -typedef ^ ^ ModVarType y : - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - typedef ^ ^ IntKi Nx - - - "" - typedef ^ ^ IntKi Nu - - - "" - typedef ^ ^ IntKi Ny - - - "" - @@ -106,12 +104,11 @@ typedef ^ ^ R8Ki dYdu :: - - typedef ^ ^ R8Ki dXdu :: - - "" - typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - -typedef ^ ^ IntKi ID - 0 - "" - -typedef ^ ^ character(ChanLen) Abbr - - - "" - -typedef ^ ^ IntKi Ins - 0 - "" - -typedef ^ ^ R8Ki DT - 0 - "" - -typedef ^ ^ IntKi SubSteps - 0 - "" - -typedef ^ ^ IntKi SolveOption - 0 - "" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index ede4402152..aabeb99cdc 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -37,10 +37,10 @@ module FAST_Eval implicit none -integer(IntKi), parameter :: IS_Option1 = 1, & - IS_Option2 = 2, & - IS_Residual = 4, & - IS_All = 255 +! Input Solve destinations +integer(IntKi), parameter :: IS_Input = 1, IS_u = 2 + +#define SOLVER_DEBUG contains @@ -265,11 +265,12 @@ logical function Failed() end function end subroutine -subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, T, ErrStat, ErrMsg) +subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: Mod !< Module data real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) integer(IntKi), intent(in) :: n_t_global !< Integer time step real(R8Ki), intent(inout) :: x_TC(:) !< Tight coupling state array + real(R8Ki), intent(inout) :: q_TC(:, :) !< Tight coupling state matrix type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -277,7 +278,7 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, T, ErrStat, ErrMs character(*), parameter :: RoutineName = 'FAST_UpdateStates' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j + integer(IntKi) :: i, j integer(IntKi) :: j_ss ! substep loop counter integer(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules real(DbKi) :: t_module ! Current simulation time for module @@ -307,18 +308,10 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, T, ErrStat, ErrMs call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) - ! Update the global reference - call BD_UpdateGlobalRef(T%BD%Input(1, Mod%Ins), & - T%BD%p(Mod%Ins), & - T%BD%x(Mod%Ins, STATE_PRED), & - T%BD%OtherSt(Mod%Ins, STATE_PRED), & - ErrStat, ErrMsg); if (Failed()) return - - ! Transfer updated states to solver - call BD_PackStateValues(T%BD%p(Mod%Ins), & - T%BD%x(Mod%Ins, STATE_PRED), & - T%BD%m(Mod%Ins)%Vals%x) - call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%x, x_TC) + ! Root node is always aligned with root motion mesh + T%BD%x(Mod%Ins, STATE_PRED)%q(:, 1) = 0.0_R8Ki + T%BD%x(Mod%Ins, STATE_PRED)%dqdt(1:3, 1) = matmul(T%BD%Input(1, Mod%Ins)%RootMotion%TranslationVel(:, 1), T%BD%OtherSt(1, Mod%Ins)%GlbRot) + T%BD%x(Mod%Ins, STATE_PRED)%dqdt(4:6, 1) = matmul(T%BD%Input(1, Mod%Ins)%RootMotion%RotationVel(:, 1), T%BD%OtherSt(1, Mod%Ins)%GlbRot) case (Module_ED) @@ -665,21 +658,32 @@ subroutine XferLocToGbl1D(Inds, Loc, Gbl) integer(IntKi), intent(in) :: Inds(:, :) real(R8Ki), intent(in) :: Loc(:) real(R8Ki), intent(inout) :: Gbl(:) - Gbl(Inds(:, 2)) = Loc(Inds(:, 1)) + integer(IntKi) :: i + do i = 1, size(Inds, dim=2) + Gbl(Inds(2, i)) = Loc(Inds(1, i)) + end do end subroutine subroutine XferGblToLoc1D(Inds, Gbl, Loc) integer(IntKi), intent(in) :: Inds(:, :) real(R8Ki), intent(in) :: Gbl(:) real(R8Ki), intent(inout) :: Loc(:) - Loc(Inds(:, 1)) = Gbl(Inds(:, 2)) + integer(IntKi) :: i + do i = 1, size(Inds, dim=2) + Loc(Inds(1, i)) = Gbl(Inds(2, i)) + end do end subroutine subroutine XferLocToGbl2D(RowInds, ColInds, Loc, Gbl) integer(IntKi), intent(in) :: RowInds(:, :), ColInds(:, :) real(R8Ki), intent(in) :: Loc(:, :) real(R8Ki), intent(inout) :: Gbl(:, :) - Gbl(RowInds(:, 2), ColInds(:, 2)) = Loc(RowInds(:, 1), ColInds(:, 1)) + integer(IntKi) :: i, j + do i = 1, size(ColInds, dim=2) + do j = 1, size(RowInds, dim=2) + Gbl(RowInds(2, j), ColInds(2, i)) = Loc(RowInds(1, j), ColInds(1, i)) + end do + end do end subroutine subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) @@ -1031,9 +1035,9 @@ subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) case (Module_BD) select case (Dst) - case (1) + case (IS_Input) u_BD => T%BD%Input(1, Mod%Ins) - case (2) + case (IS_u) u_BD => T%BD%u(Mod%Ins) end select @@ -1046,9 +1050,9 @@ subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) case (Module_ED) select case (Dst) - case (1) + case (IS_Input) u_ED => T%ED%Input(1) - case (2) + case (IS_u) u_ED => T%ED%u end select @@ -1251,10 +1255,10 @@ subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) do ir = 1, size(RowVars) if (RowVars(ir)%Field /= RowField) cycle n = 1 - mSize = RowVars(ir)%Size + mSize = RowVars(ir)%Num do ic = 1, size(ColVars) if (ColVars(ic)%Field /= ColField) cycle - nSize = ColVars(ic)%Size + nSize = ColVars(ic)%Num Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) = Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) + & Loc(m:m + mSize - 1, n:n + nSize - 1) ! write (*, *) 'Rows = ', RowVars(ir)%iGblSol diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index fa598b4050..c631e81231 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -126,20 +126,20 @@ typedef ^ ^ R8Ki AlphaF - - - typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - typedef ^ ^ R8Ki C 3 - - "Generalized-alpha coefficient array" - -typedef ^ ^ IntKi iX1Tight : - - "" - -typedef ^ ^ IntKi iX2Tight : - - "" - -typedef ^ ^ IntKi iUTight : - - "" - -typedef ^ ^ IntKi iUOpt1 : - - "" - -typedef ^ ^ IntKi iyTight : - - "" - -typedef ^ ^ IntKi iyOpt1 : - - "" - -typedef ^ ^ IntKi ixqd :: - - "" - -typedef ^ ^ IntKi iuLoad : - - "Indices of u load variables" - -typedef ^ ^ IntKi iJX2 : - - "Indices of Jacobian q variables" - -typedef ^ ^ IntKi iJT : - - "Indices of Jacobian tight coupling variables" - -typedef ^ ^ IntKi iJ1 : - - "Indices of Jacobian option 1 variables" - +typedef ^ ^ IntKi iX1 2 - - "" - +typedef ^ ^ IntKi iX2 2 - - "" - +typedef ^ ^ IntKi iUT 2 - - "" - +typedef ^ ^ IntKi iU1 2 - - "" - +typedef ^ ^ IntKi iyT 2 - - "" - +typedef ^ ^ IntKi iy1 2 - - "" - +typedef ^ ^ IntKi iJX 2 - - "Indices of Jacobian q variables" - +typedef ^ ^ IntKi iJU 2 - - "Indices of Jacobian input variables" - +typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - +typedef ^ ^ IntKi ixqd :: - - "" - typedef ^ ^ IntKi iModAll : - - "ModData index order for all modules" - typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - +typedef ^ ^ IntKi iModBD : - - "ModData index order for BD modules" - typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - @@ -175,7 +175,6 @@ typedef ^ ^ R8Ki dx : - - typedef ^ ^ R8Ki du : - - "" - typedef ^ ^ R8Ki UDiff : - - "" - typedef ^ ^ TC_MappingType Mappings : - - "Array of mesh mappings in solver" - -typedef ^ ^ IntKi DebugUnit - - - "Unit number to write debug info" - # ..... FAST_ParameterType data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 01318fab50..12f65a8f41 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -148,20 +148,20 @@ MODULE FAST_Types REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] REAL(R8Ki) , DIMENSION(1:3) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iX1Tight !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iX2Tight !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUTight !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUOpt1 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyTight !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iyOpt1 !< [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iuLoad !< Indices of u load variables [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJX2 !< Indices of Jacobian q variables [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJT !< Indices of Jacobian tight coupling variables [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJ1 !< Indices of Jacobian option 1 variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iU1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iyT = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iy1 = 0_IntKi !< [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJX = 0_IntKi !< Indices of Jacobian q variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJU = 0_IntKi !< Indices of Jacobian input variables [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModAll !< ModData index order for all modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModBD !< ModData index order for BD modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] @@ -199,7 +199,6 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] - INTEGER(IntKi) :: DebugUnit = 0_IntKi !< Unit number to write debug info [-] END TYPE TC_MiscVarType ! ======================= ! ========= FAST_ParameterType ======= @@ -1717,77 +1716,26 @@ subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTyp DstTC_ParameterTypeData%Beta = SrcTC_ParameterTypeData%Beta DstTC_ParameterTypeData%Gamma = SrcTC_ParameterTypeData%Gamma DstTC_ParameterTypeData%C = SrcTC_ParameterTypeData%C - if (allocated(SrcTC_ParameterTypeData%iX1Tight)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iX1Tight) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iX1Tight) - if (.not. allocated(DstTC_ParameterTypeData%iX1Tight)) then - allocate(DstTC_ParameterTypeData%iX1Tight(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iX1Tight.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iX1Tight = SrcTC_ParameterTypeData%iX1Tight - end if - if (allocated(SrcTC_ParameterTypeData%iX2Tight)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iX2Tight) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iX2Tight) - if (.not. allocated(DstTC_ParameterTypeData%iX2Tight)) then - allocate(DstTC_ParameterTypeData%iX2Tight(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iX2Tight.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iX2Tight = SrcTC_ParameterTypeData%iX2Tight - end if - if (allocated(SrcTC_ParameterTypeData%iUTight)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iUTight) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iUTight) - if (.not. allocated(DstTC_ParameterTypeData%iUTight)) then - allocate(DstTC_ParameterTypeData%iUTight(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iUTight.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iUTight = SrcTC_ParameterTypeData%iUTight - end if - if (allocated(SrcTC_ParameterTypeData%iUOpt1)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iUOpt1) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iUOpt1) - if (.not. allocated(DstTC_ParameterTypeData%iUOpt1)) then - allocate(DstTC_ParameterTypeData%iUOpt1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iUOpt1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iUOpt1 = SrcTC_ParameterTypeData%iUOpt1 - end if - if (allocated(SrcTC_ParameterTypeData%iyTight)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iyTight) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iyTight) - if (.not. allocated(DstTC_ParameterTypeData%iyTight)) then - allocate(DstTC_ParameterTypeData%iyTight(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iyTight.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iyTight = SrcTC_ParameterTypeData%iyTight - end if - if (allocated(SrcTC_ParameterTypeData%iyOpt1)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iyOpt1) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iyOpt1) - if (.not. allocated(DstTC_ParameterTypeData%iyOpt1)) then - allocate(DstTC_ParameterTypeData%iyOpt1(LB(1):UB(1)), stat=ErrStat2) + DstTC_ParameterTypeData%iX1 = SrcTC_ParameterTypeData%iX1 + DstTC_ParameterTypeData%iX2 = SrcTC_ParameterTypeData%iX2 + DstTC_ParameterTypeData%iUT = SrcTC_ParameterTypeData%iUT + DstTC_ParameterTypeData%iU1 = SrcTC_ParameterTypeData%iU1 + DstTC_ParameterTypeData%iyT = SrcTC_ParameterTypeData%iyT + DstTC_ParameterTypeData%iy1 = SrcTC_ParameterTypeData%iy1 + DstTC_ParameterTypeData%iJX = SrcTC_ParameterTypeData%iJX + DstTC_ParameterTypeData%iJU = SrcTC_ParameterTypeData%iJU + DstTC_ParameterTypeData%iJUT = SrcTC_ParameterTypeData%iJUT + if (allocated(SrcTC_ParameterTypeData%iJL)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iJL) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iJL) + if (.not. allocated(DstTC_ParameterTypeData%iJL)) then + allocate(DstTC_ParameterTypeData%iJL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iyOpt1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_ParameterTypeData%iyOpt1 = SrcTC_ParameterTypeData%iyOpt1 + DstTC_ParameterTypeData%iJL = SrcTC_ParameterTypeData%iJL end if if (allocated(SrcTC_ParameterTypeData%ixqd)) then LB(1:2) = lbound(SrcTC_ParameterTypeData%ixqd) @@ -1801,66 +1749,6 @@ subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTyp end if DstTC_ParameterTypeData%ixqd = SrcTC_ParameterTypeData%ixqd end if - if (allocated(SrcTC_ParameterTypeData%iuLoad)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iuLoad) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iuLoad) - if (.not. allocated(DstTC_ParameterTypeData%iuLoad)) then - allocate(DstTC_ParameterTypeData%iuLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iuLoad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iuLoad = SrcTC_ParameterTypeData%iuLoad - end if - if (allocated(SrcTC_ParameterTypeData%iJX2)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iJX2) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iJX2) - if (.not. allocated(DstTC_ParameterTypeData%iJX2)) then - allocate(DstTC_ParameterTypeData%iJX2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJX2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iJX2 = SrcTC_ParameterTypeData%iJX2 - end if - if (allocated(SrcTC_ParameterTypeData%iJT)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iJT) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iJT) - if (.not. allocated(DstTC_ParameterTypeData%iJT)) then - allocate(DstTC_ParameterTypeData%iJT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iJT = SrcTC_ParameterTypeData%iJT - end if - if (allocated(SrcTC_ParameterTypeData%iJ1)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iJ1) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iJ1) - if (.not. allocated(DstTC_ParameterTypeData%iJ1)) then - allocate(DstTC_ParameterTypeData%iJ1(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJ1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iJ1 = SrcTC_ParameterTypeData%iJ1 - end if - if (allocated(SrcTC_ParameterTypeData%iJL)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iJL) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iJL) - if (.not. allocated(DstTC_ParameterTypeData%iJL)) then - allocate(DstTC_ParameterTypeData%iJL(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iJL.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_ParameterTypeData%iJL = SrcTC_ParameterTypeData%iJL - end if if (allocated(SrcTC_ParameterTypeData%iModAll)) then LB(1:1) = lbound(SrcTC_ParameterTypeData%iModAll) UB(1:1) = ubound(SrcTC_ParameterTypeData%iModAll) @@ -1885,6 +1773,18 @@ subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTyp end if DstTC_ParameterTypeData%iModTC = SrcTC_ParameterTypeData%iModTC end if + if (allocated(SrcTC_ParameterTypeData%iModBD)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModBD) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModBD) + if (.not. allocated(DstTC_ParameterTypeData%iModBD)) then + allocate(DstTC_ParameterTypeData%iModBD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModBD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModBD = SrcTC_ParameterTypeData%iModBD + end if if (allocated(SrcTC_ParameterTypeData%iModOpt1)) then LB(1:1) = lbound(SrcTC_ParameterTypeData%iModOpt1) UB(1:1) = ubound(SrcTC_ParameterTypeData%iModOpt1) @@ -1930,48 +1830,21 @@ subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyTC_ParameterType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(TC_ParameterTypeData%iX1Tight)) then - deallocate(TC_ParameterTypeData%iX1Tight) - end if - if (allocated(TC_ParameterTypeData%iX2Tight)) then - deallocate(TC_ParameterTypeData%iX2Tight) - end if - if (allocated(TC_ParameterTypeData%iUTight)) then - deallocate(TC_ParameterTypeData%iUTight) - end if - if (allocated(TC_ParameterTypeData%iUOpt1)) then - deallocate(TC_ParameterTypeData%iUOpt1) - end if - if (allocated(TC_ParameterTypeData%iyTight)) then - deallocate(TC_ParameterTypeData%iyTight) - end if - if (allocated(TC_ParameterTypeData%iyOpt1)) then - deallocate(TC_ParameterTypeData%iyOpt1) + if (allocated(TC_ParameterTypeData%iJL)) then + deallocate(TC_ParameterTypeData%iJL) end if if (allocated(TC_ParameterTypeData%ixqd)) then deallocate(TC_ParameterTypeData%ixqd) end if - if (allocated(TC_ParameterTypeData%iuLoad)) then - deallocate(TC_ParameterTypeData%iuLoad) - end if - if (allocated(TC_ParameterTypeData%iJX2)) then - deallocate(TC_ParameterTypeData%iJX2) - end if - if (allocated(TC_ParameterTypeData%iJT)) then - deallocate(TC_ParameterTypeData%iJT) - end if - if (allocated(TC_ParameterTypeData%iJ1)) then - deallocate(TC_ParameterTypeData%iJ1) - end if - if (allocated(TC_ParameterTypeData%iJL)) then - deallocate(TC_ParameterTypeData%iJL) - end if if (allocated(TC_ParameterTypeData%iModAll)) then deallocate(TC_ParameterTypeData%iModAll) end if if (allocated(TC_ParameterTypeData%iModTC)) then deallocate(TC_ParameterTypeData%iModTC) end if + if (allocated(TC_ParameterTypeData%iModBD)) then + deallocate(TC_ParameterTypeData%iModBD) + end if if (allocated(TC_ParameterTypeData%iModOpt1)) then deallocate(TC_ParameterTypeData%iModOpt1) end if @@ -2002,66 +1875,25 @@ subroutine FAST_PackTC_ParameterType(Buf, Indata) call RegPack(Buf, InData%Beta) call RegPack(Buf, InData%Gamma) call RegPack(Buf, InData%C) - call RegPack(Buf, allocated(InData%iX1Tight)) - if (allocated(InData%iX1Tight)) then - call RegPackBounds(Buf, 1, lbound(InData%iX1Tight), ubound(InData%iX1Tight)) - call RegPack(Buf, InData%iX1Tight) - end if - call RegPack(Buf, allocated(InData%iX2Tight)) - if (allocated(InData%iX2Tight)) then - call RegPackBounds(Buf, 1, lbound(InData%iX2Tight), ubound(InData%iX2Tight)) - call RegPack(Buf, InData%iX2Tight) - end if - call RegPack(Buf, allocated(InData%iUTight)) - if (allocated(InData%iUTight)) then - call RegPackBounds(Buf, 1, lbound(InData%iUTight), ubound(InData%iUTight)) - call RegPack(Buf, InData%iUTight) - end if - call RegPack(Buf, allocated(InData%iUOpt1)) - if (allocated(InData%iUOpt1)) then - call RegPackBounds(Buf, 1, lbound(InData%iUOpt1), ubound(InData%iUOpt1)) - call RegPack(Buf, InData%iUOpt1) - end if - call RegPack(Buf, allocated(InData%iyTight)) - if (allocated(InData%iyTight)) then - call RegPackBounds(Buf, 1, lbound(InData%iyTight), ubound(InData%iyTight)) - call RegPack(Buf, InData%iyTight) - end if - call RegPack(Buf, allocated(InData%iyOpt1)) - if (allocated(InData%iyOpt1)) then - call RegPackBounds(Buf, 1, lbound(InData%iyOpt1), ubound(InData%iyOpt1)) - call RegPack(Buf, InData%iyOpt1) + call RegPack(Buf, InData%iX1) + call RegPack(Buf, InData%iX2) + call RegPack(Buf, InData%iUT) + call RegPack(Buf, InData%iU1) + call RegPack(Buf, InData%iyT) + call RegPack(Buf, InData%iy1) + call RegPack(Buf, InData%iJX) + call RegPack(Buf, InData%iJU) + call RegPack(Buf, InData%iJUT) + call RegPack(Buf, allocated(InData%iJL)) + if (allocated(InData%iJL)) then + call RegPackBounds(Buf, 1, lbound(InData%iJL), ubound(InData%iJL)) + call RegPack(Buf, InData%iJL) end if call RegPack(Buf, allocated(InData%ixqd)) if (allocated(InData%ixqd)) then call RegPackBounds(Buf, 2, lbound(InData%ixqd), ubound(InData%ixqd)) call RegPack(Buf, InData%ixqd) end if - call RegPack(Buf, allocated(InData%iuLoad)) - if (allocated(InData%iuLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%iuLoad), ubound(InData%iuLoad)) - call RegPack(Buf, InData%iuLoad) - end if - call RegPack(Buf, allocated(InData%iJX2)) - if (allocated(InData%iJX2)) then - call RegPackBounds(Buf, 1, lbound(InData%iJX2), ubound(InData%iJX2)) - call RegPack(Buf, InData%iJX2) - end if - call RegPack(Buf, allocated(InData%iJT)) - if (allocated(InData%iJT)) then - call RegPackBounds(Buf, 1, lbound(InData%iJT), ubound(InData%iJT)) - call RegPack(Buf, InData%iJT) - end if - call RegPack(Buf, allocated(InData%iJ1)) - if (allocated(InData%iJ1)) then - call RegPackBounds(Buf, 1, lbound(InData%iJ1), ubound(InData%iJ1)) - call RegPack(Buf, InData%iJ1) - end if - call RegPack(Buf, allocated(InData%iJL)) - if (allocated(InData%iJL)) then - call RegPackBounds(Buf, 1, lbound(InData%iJL), ubound(InData%iJL)) - call RegPack(Buf, InData%iJL) - end if call RegPack(Buf, allocated(InData%iModAll)) if (allocated(InData%iModAll)) then call RegPackBounds(Buf, 1, lbound(InData%iModAll), ubound(InData%iModAll)) @@ -2072,6 +1904,11 @@ subroutine FAST_PackTC_ParameterType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%iModTC), ubound(InData%iModTC)) call RegPack(Buf, InData%iModTC) end if + call RegPack(Buf, allocated(InData%iModBD)) + if (allocated(InData%iModBD)) then + call RegPackBounds(Buf, 1, lbound(InData%iModBD), ubound(InData%iModBD)) + call RegPack(Buf, InData%iModBD) + end if call RegPack(Buf, allocated(InData%iModOpt1)) if (allocated(InData%iModOpt1)) then call RegPackBounds(Buf, 1, lbound(InData%iModOpt1), ubound(InData%iModOpt1)) @@ -2126,88 +1963,36 @@ subroutine FAST_UnPackTC_ParameterType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%C) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%iX1Tight)) deallocate(OutData%iX1Tight) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%iX1) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iX1Tight(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iX1Tight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iX1Tight) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iX2Tight)) deallocate(OutData%iX2Tight) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%iX2) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iX2Tight(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iX2Tight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iX2Tight) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iUTight)) deallocate(OutData%iUTight) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%iUT) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iUTight(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iUTight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iUTight) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iUOpt1)) deallocate(OutData%iUOpt1) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%iU1) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iUOpt1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iUOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iUOpt1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iyTight)) deallocate(OutData%iyTight) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%iyT) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iyTight(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyTight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iyTight) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iyOpt1)) deallocate(OutData%iyOpt1) + call RegUnpack(Buf, OutData%iy1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iJX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iJU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iJUT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%iJL)) deallocate(OutData%iJL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iyOpt1(LB(1):UB(1)),stat=stat) + allocate(OutData%iJL(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iyOpt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iyOpt1) + call RegUnpack(Buf, OutData%iJL) if (RegCheckErr(Buf, RoutineName)) return end if if (allocated(OutData%ixqd)) deallocate(OutData%ixqd) @@ -2224,102 +2009,46 @@ subroutine FAST_UnPackTC_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%ixqd) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iuLoad)) deallocate(OutData%iuLoad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iuLoad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iuLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iuLoad) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iJX2)) deallocate(OutData%iJX2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iJX2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJX2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iJX2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iJT)) deallocate(OutData%iJT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iJT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iJT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iJ1)) deallocate(OutData%iJ1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iJ1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJ1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iJ1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%iJL)) deallocate(OutData%iJL) + if (allocated(OutData%iModAll)) deallocate(OutData%iModAll) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iJL(LB(1):UB(1)),stat=stat) + allocate(OutData%iModAll(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iJL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iJL) + call RegUnpack(Buf, OutData%iModAll) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iModAll)) deallocate(OutData%iModAll) + if (allocated(OutData%iModTC)) deallocate(OutData%iModTC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iModAll(LB(1):UB(1)),stat=stat) + allocate(OutData%iModTC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModTC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iModAll) + call RegUnpack(Buf, OutData%iModTC) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iModTC)) deallocate(OutData%iModTC) + if (allocated(OutData%iModBD)) deallocate(OutData%iModBD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iModTC(LB(1):UB(1)),stat=stat) + allocate(OutData%iModBD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModTC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModBD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iModTC) + call RegUnpack(Buf, OutData%iModBD) if (RegCheckErr(Buf, RoutineName)) return end if if (allocated(OutData%iModOpt1)) deallocate(OutData%iModOpt1) @@ -2710,7 +2439,6 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, if (ErrStat >= AbortErrLev) return end do end if - DstTC_MiscVarTypeData%DebugUnit = SrcTC_MiscVarTypeData%DebugUnit end subroutine subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) @@ -2962,7 +2690,6 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) call FAST_PackTC_MappingType(Buf, InData%Mappings(i1)) end do end if - call RegPack(Buf, InData%DebugUnit) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3360,8 +3087,6 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call FAST_UnpackTC_MappingType(Buf, OutData%Mappings(i1)) ! Mappings end do end if - call RegUnpack(Buf, OutData%DebugUnit) - if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index edde9705de..1ab64a2785 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -16,23 +16,20 @@ module Solver private -! q matrix column indices (displacement, velocity, accel, algo accel) +! Public functions +public Solver_Init, Solver_Step0, Solver_Step + +! q matrix column indices (displacement, velocity, accel, algorithmic accel) integer(IntKi), parameter :: COL_D = 1, COL_V = 2, COL_A = 3, COL_AA = 4 ! Tight coupling modules integer(IntKi), parameter :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] -public Solver_Init, Solver_Step0, Solver_Step - -! Transfer Module Flags -integer(IntKi), parameter :: XM_x = 1, & - XM_dxdt = 2, & - XM_dYdx = 4, & - XM_dXdx = 8, & - XM_dYdu = 16, & - XM_dXdu = 32 - -integer(IntKi) :: munit +! Debugging +logical, parameter :: DebugSolver = .true. +integer(IntKi) :: DebugUn = -1 +logical, parameter :: DebugJacobian = .true. +integer(IntKi) :: MatrixUn = -1 contains @@ -40,7 +37,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) type(TC_ParameterType), intent(inout) :: p !< Parameters type(TC_MiscVarType), intent(out) :: m !< Misc variables for optimization (not copied in glue code) - type(ModDataType), intent(inout) :: Mods(:) !< Solution variables from modules + type(ModDataType), intent(inout) :: Mods(:) !< Module data integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -48,10 +45,8 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 ! local error status character(ErrMsgLen) :: ErrMsg2 ! local error message integer(IntKi) :: i, j, k, n - integer(IntKi) :: NumX, NumU, NumY, NumQ, NumJac - integer(IntKi), allocatable :: iq(:), modIDs(:), vec1(:), vec2(:) - logical :: isLoad - logical, allocatable :: isLoadTight(:), isLoadOption1(:) + integer(IntKi) :: NumX, NumQ, NumU, NumY, NumJ + integer(IntKi), allocatable :: modIDs(:), vec1(:), vec2(:), iuLoad(:) type(TC_MappingType) :: MeshMap !---------------------------------------------------------------------------- @@ -92,88 +87,186 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) pack([(i, i=1, size(Mods))], ModIDs == Module_HD), & pack([(i, i=1, size(Mods))], ModIDs == Module_Orca)] + ! Ordering array for BeamDyn modules + p%iModBD = [pack([(i, i=1, size(Mods))], ModIDs == Module_BD)] + !---------------------------------------------------------------------------- ! Initialize mesh mappings (must be done before calculating global indices) !---------------------------------------------------------------------------- - call Solver_DefineMappings(m%Mappings, Mods, ErrStat2, ErrMsg2); if (Failed()) return + call Solver_DefineMappings(m%Mappings, Mods, ErrStat2, ErrMsg2) + if (Failed()) return !---------------------------------------------------------------------------- - ! Calculate Variable cateogries and global indices - ! TODO: reorder to improve data locality + ! Calculate state variable global indices and transfer index arrays + ! for tight coupling modules !---------------------------------------------------------------------------- + ! Initialize number of state variables to zero NumX = 0 - do i = 1, size(Mods) - vec1 = [(0, k=1, 0)] - vec2 = [(0, k=1, 0)] - do j = 1, size(Mods(i)%Vars%x) - Mods(i)%Vars%x(j)%Cat = VarCategory(Mods(i)%ID, Mods(i)%Vars%x(j)%Field) - if (Mods(i)%Vars%x(j)%Cat == VC_Tight) then - Mods(i)%Vars%x(j)%iGblSol = [(NumX + k, k=1, Mods(i)%Vars%x(j)%Size)] - vec1 = [vec1, Mods(i)%Vars%x(j)%iLoc] - vec2 = [vec2, Mods(i)%Vars%x(j)%iGblSol] - NumX = NumX + Mods(i)%Vars%x(j)%Size - end if - end do - Mods(i)%ixs = reshape([vec1, vec2], [size(vec1), 2]) + + ! Loop through tight coupling modules, set Solve flag + do i = 1, size(p%iModTC) + associate (Mod => Mods(p%iModTC(i))) + do j = 1, size(Mod%Vars%x) + call SetFlags(Mod%Vars%x(j), VF_Solve) + end do + end associate + end do + + ! Loop through x displacement variables (DerivOrder == 0), set global index + do i = 1, size(p%iModTC) + associate (Mod => Mods(p%iModTC(i))) + do j = 1, size(Mod%Vars%x) + if (Mod%Vars%x(j)%DerivOrder == 0) then + Mod%Vars%x(j)%iGblSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] + NumX = NumX + Mod%Vars%x(j)%Num + end if + end do + end associate + end do + + ! Start and end indices for first derivative of X + p%iX1 = [1, NumX] + + ! Loop through x velocity variables (DerivOrder == 1), set global index + do i = 1, size(p%iModTC) + associate (Mod => Mods(p%iModTC(i))) + do j = 1, size(Mod%Vars%x) + if (Mod%Vars%x(j)%DerivOrder == 1) then + Mod%Vars%x(j)%iGblSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] + NumX = NumX + Mod%Vars%x(j)%Num + end if + end do + end associate + end do + + ! Start and end indices for second derivative of X + p%iX2 = [p%iX1(2) + 1, NumX] + + ! Loop through x variables, and collect global and local indices + do i = 1, size(p%iModTC) + allocate (vec1(0), vec2(0)) + associate (Mod => Mods(p%iModTC(i))) + do j = 1, size(Mod%Vars%x) + vec1 = [vec1, Mod%Vars%x(j)%iLoc] + vec2 = [vec2, Mod%Vars%x(j)%iGblSol] + end do + call AllocAry(Mod%ixs, 2, size(vec1), "Mod%ixs", ErrStat2, ErrMsg2); if (Failed()) return + Mod%ixs(1, :) = vec1 + Mod%ixs(2, :) = vec2 + end associate + deallocate (vec1, vec2) end do + !---------------------------------------------------------------------------- + ! Calculate input variable global indices and transfer arrays + ! for tight coupling and option one modules + !---------------------------------------------------------------------------- + + allocate (iuLoad(0)) + + ! Initialze number of input variables to zero NumU = 0 - do i = 1, size(Mods) - vec1 = [(0, k=1, 0)] - vec2 = [(0, k=1, 0)] - do j = 1, size(Mods(i)%Vars%u) - Mods(i)%Vars%u(j)%Cat = VarCategory(Mods(i)%ID, Mods(i)%Vars%u(j)%Field) - if (iand(Mods(i)%Vars%u(j)%Flags, VF_Solve) > 0) then - Mods(i)%Vars%u(j)%iGblSol = [(NumU + k, k=1, Mods(i)%Vars%u(j)%Size)] - vec1 = [vec1, Mods(i)%Vars%u(j)%iLoc] - vec2 = [vec2, Mods(i)%Vars%u(j)%iGblSol] - NumU = NumU + Mods(i)%Vars%u(j)%Size - end if + + ! Loop through tight coupling modules and calculate global indices + do i = 1, size(p%iModTC) + do j = 1, size(Mods(p%iModTC(i))%Vars%u) + associate (Var => Mods(p%iModTC(i))%Vars%u(j)) + if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iGblSol = [(NumU + k, k=1, Var%Num)] + NumU = NumU + Var%Num + end if + end associate end do - Mods(i)%ius = reshape([vec1, vec2], [size(vec1), 2]) end do - NumY = 0 + ! Save number of tight coupling inputs + p%iUT = [1, NumU] + + ! Loop through option 1 modules and calculate global indices + do i = 1, size(p%iModOpt1) + do j = 1, size(Mods(p%iModOpt1(i))%Vars%u) + associate (Var => Mods(p%iModOpt1(i))%Vars%u(j)) + if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iGblSol = [(NumU + k, k=1, Var%Num)] + NumU = NumU + Var%Num + end if + end associate + end do + end do + + ! Calculate number of option 1 inputs + p%iU1 = [p%iUT(2) + 1, NumU] + + ! Loop through all modules do i = 1, size(Mods) - vec1 = [(0, k=1, 0)] - vec2 = [(0, k=1, 0)] - do j = 1, size(Mods(i)%Vars%y) - Mods(i)%Vars%y(j)%Cat = VarCategory(Mods(i)%ID, Mods(i)%Vars%y(j)%Field) - if (iand(Mods(i)%Vars%y(j)%Flags, VF_Solve) > 0) then - Mods(i)%Vars%y(j)%iGblSol = [(NumY + k, k=1, Mods(i)%Vars%y(j)%Size)] - vec1 = [vec1, Mods(i)%Vars%y(j)%iLoc] - vec2 = [vec2, Mods(i)%Vars%y(j)%iGblSol] - NumY = NumY + Mods(i)%Vars%y(j)%Size - end if + allocate (vec1(0), vec2(0)) + do j = 1, size(Mods(i)%Vars%u) + if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle + vec1 = [vec1, Mods(i)%Vars%u(j)%iLoc] + vec2 = [vec2, Mods(i)%Vars%u(j)%iGblSol] + select case (Mods(i)%Vars%u(j)%Field) + case (VF_Force, VF_Moment) + iuLoad = [iuLoad, Mods(i)%Vars%u(j)%iGblSol] + end select end do - Mods(i)%iys = reshape([vec1, vec2], [size(vec1), 2]) + call AllocAry(Mods(i)%ius, 2, size(vec1), "Mods(i)%ius", ErrStat2, ErrMsg2); if (Failed()) return + Mods(i)%ius(1, :) = vec1 + Mods(i)%ius(2, :) = vec2 + deallocate (vec1, vec2) end do !---------------------------------------------------------------------------- - ! Allocate storage + ! Calculate output variable categories and indices !---------------------------------------------------------------------------- - ! State and State Derivative - call AllocAry(m%x, NumX, "m%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%xn, NumX, "m%xn", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dx, NumX, "m%dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dxdt, NumX, "m%dxdt", ErrStat2, ErrMsg2); if (Failed()) return - m%x = 0.0_R8Ki - m%dx = 0.0_R8Ki - m%dxdt = 0.0_R8Ki + ! Initialize the number of output variables + NumY = 0 - ! Inputs and Input Temporary - call AllocAry(m%u, NumU, "m%u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%un, NumU, "m%un", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%du, NumU, "m%du", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%u_tmp, NumU, "m%u_tmp", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%UDiff, NumU, "m%UDiff", ErrStat2, ErrMsg2); if (Failed()) return + ! Loop through tight coupling modules and calculate global indices + do i = 1, size(p%iModTC) + do j = 1, size(Mods(p%iModTC(i))%Vars%y) + associate (Var => Mods(p%iModTC(i))%Vars%y(j)) + if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iGblSol = [(NumY + k, k=1, Var%Num)] + NumY = NumY + Var%Num + end if + end associate + end do + end do - ! Outputs - call AllocAry(m%y, NumY, "m%y", ErrStat2, ErrMsg2); if (Failed()) return - m%y = 0.0_R8Ki + ! Save number of tight coupling inputs + p%iyT = [1, NumY] + + ! Loop through option 1 modules and calculate global indices + do i = 1, size(p%iModOpt1) + do j = 1, size(Mods(p%iModOpt1(i))%Vars%y) + associate (Var => Mods(p%iModOpt1(i))%Vars%y(j)) + if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iGblSol = [(NumY + k, k=1, Var%Num)] + NumY = NumY + Var%Num + end if + end associate + end do + end do + + ! Calculate number of option 1 inputs + p%iy1 = [p%iyT(2) + 1, NumY] + + ! Loop through all modules + do i = 1, size(Mods) + allocate (vec1(0), vec2(0)) + do j = 1, size(Mods(i)%Vars%y) + if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle + vec1 = [vec1, Mods(i)%Vars%y(j)%iLoc] + vec2 = [vec2, Mods(i)%Vars%y(j)%iGblSol] + end do + call AllocAry(Mods(i)%iys, 2, size(vec1), "Mods(i)%iys", ErrStat2, ErrMsg2); if (Failed()) return + Mods(i)%iys(1, :) = vec1 + Mods(i)%iys(2, :) = vec2 + deallocate (vec1, vec2) + end do !---------------------------------------------------------------------------- ! Allocate q storage for generalized alpha algorithm @@ -196,10 +289,6 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Loop through modules do i = 1, size(Mods) - ! Allocate iq to store q index for each variable - call AllocAry(iq, size(Mods(i)%Vars%x), "iq", ErrStat2, ErrMsg2); if (Failed()) return - iq = 0 - ! Skip modules that aren't in tight coupling if (all(Mods(i)%ID /= TC_Modules)) cycle @@ -207,14 +296,14 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) do j = 1, size(Mods(i)%Vars%x) ! Skip variables which already have a q index - if (iq(j) /= 0) cycle + if (allocated(Mods(i)%Vars%x(j)%iq)) cycle ! Skip load variables (force and moment) if (any(Mods(i)%Vars%x(j)%Field == LoadFields)) cycle ! Set q index for variable and update number - iq(j) = NumQ + 1 - NumQ = NumQ + Mods(i)%Vars%x(j)%Size + Mods(i)%Vars%x(j)%iq = [(NumQ + k, k=1, Mods(i)%Vars%x(j)%Num)] + NumQ = NumQ + Mods(i)%Vars%x(j)%Num ! Loop through remaining vars if the names match do k = i + 1, size(Mods(i)%Vars%x) @@ -232,8 +321,8 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) cycle end select - ! Copy q index - iq(k) = iq(j) + ! Copy q row indices + Mods(i)%Vars%x(k)%iq = Mods(i)%Vars%x(j)%iq end do end do @@ -241,87 +330,41 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Loop through state variables and build mapping array between x and q ! ixqd is 3xN where each row is [global x array index, q matrix row, q matrix col] do j = 1, size(Mods(i)%Vars%x) - do k = 1, Mods(i)%Vars%x(j)%Size + do k = 1, Mods(i)%Vars%x(j)%Num n = n + 1 - p%ixqd(:, n) = [Mods(i)%Vars%x(j)%iGblSol(k), iq(j) + k - 1, Mods(i)%Vars%x(j)%DerivOrder + 1] + p%ixqd(:, n) = [Mods(i)%Vars%x(j)%iGblSol(k), Mods(i)%Vars%x(j)%iq(k), Mods(i)%Vars%x(j)%DerivOrder + 1] end do end do - ! Deallocate iq for use by next module - deallocate (iq) end do ! Remove x->q indicies that aren't set p%ixqd = p%ixqd(:, 1:n) - ! Allocate/initialize global q storage - call AllocAry(m%q, NumQ, 4, "m%q", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%qn, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dq, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return - m%q = 0.0_R8Ki - m%qn = 0.0_R8Ki - m%dq = 0.0_R8Ki - !---------------------------------------------------------------------------- - ! Mapping arrays + ! Allocate state and input storage !---------------------------------------------------------------------------- - ! Calculate index mapping arrays for X1Tight and X2Tight - call AllocAry(p%iX1Tight, 0, "p%iX1Tight", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(p%iX2Tight, 0, "p%iX2Tight", ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(Mods) - do j = 1, size(Mods(i)%Vars%x) - if (Mods(i)%Vars%x(j)%Cat == VC_Tight) then - select case (Mods(i)%Vars%x(j)%DerivOrder) - case (0) - p%iX1Tight = [p%iX1Tight, Mods(i)%Vars%x(j)%iGblSol] - case (1) - p%iX2Tight = [p%iX2Tight, Mods(i)%Vars%x(j)%iGblSol] - end select - end if - end do - end do + ! State, State delta, and State Derivative + call AllocAry(m%x, NumX, "m%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%xn, NumX, "m%xn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dx, NumX, "m%dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dxdt, NumX, "m%dxdt", ErrStat2, ErrMsg2); if (Failed()) return - ! Calculate index mapping arrays for U^Tight and U^Option1 - call AllocAry(p%iuLoad, 0, "p%iuLoad", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(p%iUTight, 0, "p%iUTight", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(p%iUOpt1, 0, "p%iUOpt1", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(isLoadTight, 0, "isLoadTight", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(isLoadOption1, 0, "isLoadOption1", ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(Mods) - do j = 1, size(Mods(i)%Vars%u) - associate (Var => Mods(i)%Vars%u(j)) - if (iand(Var%Flags, VF_Solve) == 0) cycle - isLoad = any(LoadFields == Var%Field) - select case (Var%Cat) - case (VC_Tight) - p%iUTight = [p%iUTight, Var%iGblSol] - isLoadTight = [isLoadTight, spread(isLoad, 1, Var%Size)] - case (VC_Option1) - p%iUOpt1 = [p%iUOpt1, Var%iGblSol] - isLoadOption1 = [isLoadOption1, spread(isLoad, 1, Var%Size)] - end select - if (isLoad) then - p%iuLoad = [p%iuLoad, Var%iGblSol] - end if - end associate - end do - end do + ! Inputs and Input Temporary + call AllocAry(m%u, NumU, "m%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%un, NumU, "m%un", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%du, NumU, "m%du", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%u_tmp, NumU, "m%u_tmp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%UDiff, NumU, "m%UDiff", ErrStat2, ErrMsg2); if (Failed()) return - ! Calculate index mapping arrays for y^Tight and y^Option1 - call AllocAry(p%iyTight, 0, "p%iyTight", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(p%iyOpt1, 0, "p%iyOpt1", ErrStat2, ErrMsg2); if (Failed()) return - do i = 1, size(Mods) - do j = 1, size(Mods(i)%Vars%y) - if (iand(Mods(i)%Vars%y(j)%Flags, VF_Solve) == 0) cycle - select case (Mods(i)%Vars%y(j)%Cat) - case (VC_Tight) - p%iyTight = [p%iyTight, Mods(i)%Vars%y(j)%iGblSol] - case (VC_Option1) - p%iyOpt1 = [p%iyOpt1, Mods(i)%Vars%y(j)%iGblSol] - end select - end do - end do + ! Outputs + call AllocAry(m%y, NumY, "m%y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate/initialize global q storage + call AllocAry(m%q, NumQ, 4, "m%q", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%qn, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dq, NumQ, 4, "m%dq", ErrStat2, ErrMsg2); if (Failed()) return !---------------------------------------------------------------------------- ! Allocate Jacobian matrices @@ -336,40 +379,27 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) call AllocAry(m%G, NumU, NumU, "m%G", ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(m%IPIV2, NumU, "m%IPIV2", ErrStat2, ErrMsg2); if (Failed()) return - ! Initialize Jacobian matrices - m%dYdx = 0.0_R8Ki - m%dYdu = 0.0_R8Ki - m%dXdx = 0.0_R8Ki - m%dXdu = 0.0_R8Ki - m%dUdu = 0.0_R8Ki - m%dUdy = 0.0_R8Ki - !---------------------------------------------------------------------------- ! Allocate solver Jacobian matrix, RHS, and Delta !---------------------------------------------------------------------------- - ! Initialize size of system - NumJac = 0 - - ! Allocate and initialize indices of q vars in Jacobian matrix - p%iJX2 = [(NumJac + i, i=1, size(p%iX2Tight))] - NumJac = NumJac + size(p%iJX2) + ! Calculate size of Jacobian matrix + NumJ = NumQ + NumU - ! Allocate and initialize indices of tight coupling vars in Jacobian matrix - p%iJT = [(NumJac + i, i=1, size(p%iUTight))] - NumJac = NumJac + size(p%iJT) + ! Get start and end indicies for state part of Jacobian + p%iJX = [1, NumQ] - ! Allocate and initialize indices of option 1 vars in Jacobian matrix - p%iJ1 = [(NumJac + i, i=1, size(p%iUOpt1))] - NumJac = NumJac + size(p%iJ1) + ! Get start and end indicies for input part of Jacobian + p%iJUT = p%iUT + NumQ + p%iJU = [1, NumU] + NumQ ! Get Jacobian indicies containing loads - p%iJL = [pack(p%iJT, isLoadTight), pack(p%iJ1, isLoadOption1)] + p%iJL = iuLoad + NumQ ! Allocate Macobian matrix, RHS/X matrix, Pivot array - call AllocAry(m%Jac, NumJac, NumJac, "m%Jac", ErrStat, ErrMsg); if (Failed()) return - call AllocAry(m%XB, NumJac, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return - call AllocAry(m%IPIV, NumJac, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%Jac, NumJ, NumJ, "m%Jac", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%XB, NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%IPIV, NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return m%Jac = 0.0_R8Ki ! Initialize iterations and steps until Jacobian is calculated to zero @@ -381,7 +411,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Calculate generalized alpha parameters !---------------------------------------------------------------------------- - p%AccBlend = 1.0_R8Ki + p%AccBlend = 0.0_R8Ki p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) @@ -396,90 +426,22 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Debug !---------------------------------------------------------------------------- - ! munit = -1 - - ! call GetNewUnit(m%DebugUnit, ErrStat2, ErrMsg2); if (Failed()) return - ! call OpenFOutFile(m%DebugUnit, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return - - ! write (m%DebugUnit, *) "NumX = ", NumX - ! write (m%DebugUnit, *) "NumU = ", NumU - ! write (m%DebugUnit, *) "NumY = ", NumY - ! write (m%DebugUnit, *) "NumJac = ", NumJac - ! write (m%DebugUnit, '(A,*(I4))') " p%iJX2 = ", p%iJX2 - ! write (m%DebugUnit, '(A,*(I4))') " p%iJT = ", p%iJT - ! write (m%DebugUnit, '(A,*(I4))') " p%iJ1 = ", p%iJ1 - ! write (m%DebugUnit, '(A,*(I4))') " p%iJL = ", p%iJL - ! write (m%DebugUnit, '(A,*(I4))') " p%iX2Tight = ", p%iX2Tight - ! write (m%DebugUnit, '(A,*(I4))') " p%iX1Tight = ", p%iX1Tight - ! write (m%DebugUnit, '(A,*(I4))') " p%iUTight = ", p%iUTight - ! write (m%DebugUnit, '(A,*(I4))') " p%iUOpt1 = ", p%iUOpt1 - ! write (m%DebugUnit, '(A,*(I4))') " p%iyTight = ", p%iyTight - ! write (m%DebugUnit, '(A,*(I4))') " p%iyOpt1 = ", p%iyOpt1 - ! write (m%DebugUnit, *) "shape(m%dYdx) = ", shape(m%dYdx) - ! write (m%DebugUnit, *) "shape(m%dYdu) = ", shape(m%dYdu) - ! write (m%DebugUnit, *) "shape(m%dXdx) = ", shape(m%dXdx) - ! write (m%DebugUnit, *) "shape(m%dXdu) = ", shape(m%dXdu) - ! write (m%DebugUnit, *) "shape(m%dUdu) = ", shape(m%dUdu) - ! write (m%DebugUnit, *) "shape(m%dUdy) = ", shape(m%dUdy) - - ! do i = 1, size(Mods) - ! write (m%DebugUnit, *) "Module = ", Mods(i)%Abbr - ! write (m%DebugUnit, *) "ModuleID = ", Mods(i)%ID - ! do j = 1, size(Mods(i)%Vars%x) - ! if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle - ! write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & - ! " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" - ! write (m%DebugUnit, '(A,*(I4))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc - ! write (m%DebugUnit, '(A,*(I4))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol - ! end do - ! do j = 1, size(Mods(i)%Vars%u) - ! if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle - ! write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & - ! " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" - ! write (m%DebugUnit, '(A,*(I4))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc - ! write (m%DebugUnit, '(A,*(I4))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol - ! end do - ! do j = 1, size(Mods(i)%Vars%y) - ! if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle - ! write (m%DebugUnit, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & - ! " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" - ! write (m%DebugUnit, '(A,*(I4))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc - ! write (m%DebugUnit, '(A,*(I4))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol - ! end do - ! end do + if (DebugSolver) then + call GetNewUnit(DebugUn, ErrStat2, ErrMsg2); if (Failed()) return + call OpenFOutFile(DebugUn, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return + call Solver_Init_Debug(p, m, Mods) + end if contains - function Failed() - logical :: Failed + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function - - pure function VarCategory(ModID, VarField) result(VarCat) - integer(IntKi), intent(in) :: ModID, VarField - integer(IntKi) :: VarCat - ! If tight coupling module, then category is Tight - if (any(ModID == TC_Modules)) then - VarCat = VC_Tight - return - end if - select case (VarField) - case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position - VarCat = VC_Option2 - case (VF_TransVel, VF_AngularVel) ! Velocity - VarCat = VC_Option2 - case (VF_TransAcc, VF_AngularAcc) ! Acceleration - VarCat = VC_Option1 - case default - VarCat = VC_None - end select - end function - end subroutine subroutine Solver_DefineMappings(Mappings, Mods, ErrStat, ErrMsg) type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) - type(ModDataType), intent(inout) :: Mods(:) !< Solution variables from modules + type(ModDataType), intent(inout) :: Mods(:) !< Module data integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -672,7 +634,7 @@ end function NeedWriteOutput subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inout) :: m !< Misc variables - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + type(ModDataType), intent(in) :: ModData(:) !< Module data type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -781,6 +743,7 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Initialize algorithmic acceleration from actual acceleration m%qn(:, COL_AA) = m%qn(:, COL_A) + m%q = m%qn !---------------------------------------------------------------------------- ! Initialize module input and state arrays for interpolation/extrapolation @@ -808,7 +771,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM real(DbKi), intent(in) :: t_initial !< Initial simulation time type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inout) :: m !< Misc variables - type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules + type(ModDataType), intent(in) :: Mods(:) !< Module data type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -822,7 +785,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM real(ReKi) :: delta_norm real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 - integer(IntKi) :: i + integer(IntKi) :: i, j ErrStat = ErrID_None ErrMsg = '' @@ -841,8 +804,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 - ! write (m%DebugUnit, *) "step = ", n_t_global_next - !---------------------------------------------------------------------------- ! Extrapolate/interpolate inputs for all modules !---------------------------------------------------------------------------- @@ -865,13 +826,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Algorithm acceleration for next step m%q(:, COL_AA) = ((1.0_R8Ki - p%AlphaF)*m%q(:, COL_A) + & p%AlphaF*m%qn(:, COL_A) - & - p%AlphaM*m%qn(:, COL_AA))/(1 - p%AlphaM) + p%AlphaM*m%qn(:, COL_AA))/(1.0_R8Ki - p%AlphaM) ! Calculate change in position and velocities ! (position states include orientations which must be composed with deltas) m%dq = 0.0_R8Ki - m%dq(:, COL_V) = p%DT*(1 - p%Gamma)*m%qn(:, COL_AA) + p%DT*p%Gamma*m%q(:, COL_AA) - m%dq(:, COL_D) = p%DT*m%qn(:, COL_V) + p%DT**2*(0.5 - p%Beta)*m%qn(:, COL_AA) + p%DT**2*p%Beta*m%q(:, COL_AA) + m%dq(:, COL_V) = p%DT*(1.0_R8Ki - p%Gamma)*m%qn(:, COL_AA) + p%DT*p%Gamma*m%q(:, COL_AA) + m%dq(:, COL_D) = p%DT*m%qn(:, COL_V) + p%DT**2*(0.5_R8Ki - p%Beta)*m%qn(:, COL_AA) + p%DT**2*p%Beta*m%q(:, COL_AA) ! Transfer delta state matrix to delta x array m%dx = 0.0_R8Ki @@ -897,8 +858,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM iterCorr = 0 do while (iterCorr <= p%NumCrctn) - ! write (m%DebugUnit, *) "iterCorr = ", iterCorr - ! Copy state for correction step m%qn = m%q m%xn = m%x @@ -914,7 +873,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do i = 1, size(p%iModOpt2) call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, m%xn, & + call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, m%xn, m%qn, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return @@ -932,7 +891,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do i = 1, size(p%iModOpt1US) call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, m%xn, & + call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, m%xn, m%qn, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -973,11 +932,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- ! If number of iterations or steps until Jacobian is to be updated - ! is zero or less, or first solution step, then rebuild the Jacobian. - ! Note: Solver_BuildJacobian resets these counters. + ! is zero or less, or first solution step, then rebuild the Jacobian. + ! Note: BuildJacobian resets these counters. if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0) .or. (n_t_global_next == 1)) then - call Solver_BuildJacobian(p, m, Mods, t_global_next, n_t_global_next*100 + iterConv, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call BuildJacobian(p, m, Mods, t_global_next, n_t_global_next*100 + iterConv, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return end if !---------------------------------------------------------------------- @@ -991,7 +950,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do ! Calculate difference between predicted and actual accelerations - m%XB(p%iJX2, 1) = m%qn(:, COL_A) - m%dxdt(p%iX2Tight) + m%XB(p%iJX(1):p%iJX(2), 1) = m%qn(:, COL_A) - m%dxdt(p%iX2(1):p%iX2(2)) ! Transfer Option 1 outputs to temporary inputs and collect into u_tmp do i = 1, size(p%iModOpt1) @@ -1000,13 +959,12 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, 2, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do - call PackModuleInputs(Mods, p%iModOpt1, Turbine, u_tmp=m%u_tmp) + call PackModuleUs(Mods, p%iModOpt1, Turbine, m%u_tmp) ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules - call ComputeDiffU(Mods, p%iModOpt1, m%un, m%u_tmp, m%UDiff) - m%XB(p%iJT, 1) = m%UDiff(p%iUTight) - m%XB(p%iJ1, 1) = m%UDiff(p%iUOpt1) + call ComputeDeltaU(Mods, p%iModOpt1, m%un, m%u_tmp, m%UDiff) + m%XB(p%iJU(1):p%iJU(2), 1) = m%UDiff ! Apply conditioning factor to loads in RHS m%XB(p%iJL, 1) = m%XB(p%iJL, 1)/p%Scale_UJac @@ -1024,6 +982,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) + if (DebugSolver) then + call Solver_Step_Debug(p, m, n_t_global_next, iterCorr, iterConv, delta_norm) + end if + if (delta_norm < p%ConvTol) exit ! Remove conditioning @@ -1034,10 +996,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- ! Calculate change in state matrix - m%dq(:, COL_D) = -p%C(3)*m%XB(p%iJX2, 1) - m%dq(:, COL_V) = -p%C(2)*m%XB(p%iJX2, 1) - m%dq(:, COL_A) = -m%XB(p%iJX2, 1) - m%dq(:, COL_AA) = -p%C(1)*m%XB(p%iJX2, 1) + m%dq(:, COL_D) = -p%C(3)*m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_V) = -p%C(2)*m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_A) = -m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_AA) = -p%C(1)*m%XB(p%iJX(1):p%iJX(2), 1) + + ! Update state matrix with deltas + m%qn = m%qn + m%dq ! Transfer change in q state matrix to change in x array m%dx = 0.0_R8Ki @@ -1046,9 +1011,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Add delta to x array to get new states (respect variable fields) call AddDeltaToStates(Mods, p%iModTC, m%dx, m%xn) - ! Update new state matrix with new state array values - ! The transfer overwrites values that were changed in AddDeltaToStates - m%qn = m%qn + m%dq + ! Overwrites state matrix values that were changed in AddDeltaToStates call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) ! Transfer updated state to TC modules @@ -1059,8 +1022,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- ! Update change in inputs - m%du(p%iUTight) = -m%XB(p%iJT, 1) - m%du(p%iUOpt1) = -m%XB(p%iJ1, 1) + m%du = -m%XB(p%iJU(1):p%iJU(2), 1) ! Apply deltas to inputs, update modules call AddDeltaToInputs(Mods, p%iModOpt1, m%du, m%un) @@ -1068,20 +1030,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer updated inputs to Option 1 modules call UnpackModuleInputs(Mods, p%iModOpt1, Turbine, u=m%un) - !---------------------------------------------------------------------- - ! Transfer updated states and inputs to relevant modules - !---------------------------------------------------------------------- - - ! write (m%DebugUnit, *) "iterConv = ", iterConv - ! write (m%DebugUnit, '(A,*(ES16.7))') " y = ", m%y - ! write (m%DebugUnit, '(A,*(ES16.7))') " u = ", m%un - ! write (m%DebugUnit, '(A,*(ES16.7))') " u_tmp = ", m%u_tmp - ! write (m%DebugUnit, '(A,*(ES16.7))') " U = ", m%UDiff - ! write (m%DebugUnit, '(A,*(ES16.7))') " x = ", m%xn - ! write (m%DebugUnit, *) "delta_norm = ", delta_norm - ! write (m%DebugUnit, '(A,*(ES16.7))') " du = ", m%du - ! write (m%DebugUnit, '(A,*(ES16.7))') " dx = ", m%dx - end do iterCorr = iterCorr + 1 @@ -1097,6 +1045,49 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Update states for next step !---------------------------------------------------------------------------- + ! Loop through BeamDyn instances + do i = 1, size(p%iModBD) + associate (Mod => Mods(p%iModBD(i)), & + p_BD => Turbine%BD%p(Mods(p%iModBD(i))%Ins), & + m_BD => Turbine%BD%m(Mods(p%iModBD(i))%Ins), & + u_BD => Turbine%BD%Input(1, Mods(p%iModBD(i))%Ins), & + x_BD => Turbine%BD%x(Mods(p%iModBD(i))%Ins, STATE_PRED), & + os_BD => Turbine%BD%OtherSt(Mods(p%iModBD(i))%Ins, STATE_PRED)) + + ! Update accelerations and algorithmic accelerations + do j = 1, size(p_BD%Vars%x) + select case (p_BD%Vars%x(j)%Field) + case (VF_TransDisp) + os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_A) + os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) + case (VF_Orientation) + os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_A) + os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) + end select + end do + + ! Update the global reference + ! call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg); if (Failed()) return + + ! Update accelerations and algorithmic accelerations + do j = 1, size(p_BD%Vars%x) + select case (p_BD%Vars%x(j)%Field) + case (VF_TransDisp) + m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) + m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) + case (VF_Orientation) + m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) + m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) + end select + end do + + ! Transfer updated states to solver + call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) + call XferLocToGbl1D(Mod%ixs, m_BD%Vals%x, m%xn) + end associate + + end do + ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(p%iModAll) call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return @@ -1126,58 +1117,9 @@ logical function Failed() end function end subroutine -subroutine ComputeDiffU(Mods, ModOrder, PosAry, NegAry, DiffAry) - type(ModDataType), intent(in) :: Mods(:) ! Array of variables - integer(IntKi), intent(in) :: ModOrder(:) - real(R8Ki), intent(in) :: PosAry(:) ! Positive result array - real(R8Ki), intent(in) :: NegAry(:) ! Negative result array - real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference - integer(IntKi) :: i, j, k, ind(3) - real(R8Ki) :: DeltaWM(3), n(3), phi - - ! Loop through module index order - do i = 1, size(ModOrder) - - ! Loop through input variables in module - do j = 1, size(Mods(ModOrder(i))%Vars%u) - - associate (Var => Mods(ModOrder(i))%Vars%u(j)) - - if (.not. allocated(Var%iGblSol)) cycle - - ! If variable field is orientation - if (Var%Field == VF_Orientation) then - - ! Loop through nodes - do k = 1, Var%Nodes - - ! Get vector of indicies of WM rotation parameters in array - ind = Var%iGblSol(3*(k - 1) + 1:3*k) - - ! Compose WM parameters to go from negative to positive array - DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) - - ! Calculate change in rotation in XYZ in radians - ! phi = TwoNorm(DeltaWM) - ! n = DeltaWM/phi - ! DiffAry(ind) = 4.0_R8Ki*atan(phi/4.0_R8Ki)*n - ! DiffAry(ind) = 4.0_R8Ki*atan(DeltaWM/4.0_R8Ki) - DiffAry(ind) = DeltaWM - end do - - else - - ! Subtract negative array from positive array - DiffAry(Var%iGblSol) = PosAry(Var%iGblSol) - NegAry(Var%iGblSol) - end if - end associate - end do - end do -end subroutine - -subroutine Solver_BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) +subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: p !< Parameters - type(TC_MiscVarType), intent(inOUT) :: m !< Misc variables + type(TC_MiscVarType), intent(inout) :: m !< Misc variables type(ModDataType), intent(in) :: Mods(:) !< Array of module data real(DbKi), intent(in) :: this_time !< Time integer(IntKi), intent(in) :: iter @@ -1185,7 +1127,7 @@ subroutine Solver_BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, E integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'Solver_BuildJacobian' + character(*), parameter :: RoutineName = 'BuildJacobian' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i, j @@ -1203,7 +1145,7 @@ subroutine Solver_BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, E ! Get module Jacobians and assemble !---------------------------------------------------------------------------- - ! Initialize matrices + ! Initialize Jacobian matrices m%dYdx = 0.0_R8Ki m%dXdx = 0.0_R8Ki m%dXdu = 0.0_R8Ki @@ -1239,70 +1181,47 @@ subroutine Solver_BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, E ! G ! m%G = m%dUdu + matmul(m%dUdy, m%dYdu) m%G = m%dUdu - call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%dUdy, m%dYdu, 1.0_R8Ki, m%G, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_GEMM('N', 'N', 1.0_R8Ki, m%dUdy, m%dYdu, 1.0_R8Ki, m%G, ErrStat2, ErrMsg2) + if (Failed()) return + !---------------------------------------------------------------------------- ! Assemble Jacobian !---------------------------------------------------------------------------- ! Group (1,1) - m%Jac(p%iJX2, p%iJX2) = -p%C(2)*m%dXdx(p%iX2Tight, p%iX2Tight) - p%C(3)*m%dXdx(p%iX2Tight, p%iX1Tight) - do i = 1, size(p%iJX2) - m%Jac(p%iJX2(i), p%iJX2(i)) = m%Jac(p%iJX2(i), p%iJX2(i)) + 1.0_R8Ki + m%Jac(p%iJX(1):p%iJX(2), p%iJX(1):p%iJX(2)) = & + -p%C(2)*m%dXdx(p%iX2(1):p%iX2(2), p%iX2(1):p%iX2(2)) - & + p%C(3)*m%dXdx(p%iX2(1):p%iX2(2), p%iX1(1):p%iX1(2)) + do i = p%iJX(1), p%iJX(2) + m%Jac(i, i) = m%Jac(i, i) + 1.0_R8Ki end do ! Group (2,1) - m%Jac(p%iJT, p%iJX2) = p%C(2)*matmul(m%dUdy(p%iUTight, p%iyTight), m%dYdx(p%iyTight, p%iX2Tight)) + & - p%C(3)*matmul(m%dUdy(p%iUTight, p%iyTight), m%dYdx(p%iyTight, p%iX1Tight)) + m%Jac(p%iJUT(1):p%iJUT(2), p%iJX(1):p%iJX(2)) = & + p%C(2)*matmul(m%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + m%dYdx(p%iyT(1):p%iyT(2), p%iX2(1):p%iX2(2))) + & + p%C(3)*matmul(m%dUdy(p%iUT(1):p%iUT(2), p%iyT(1):p%iyT(2)), & + m%dYdx(p%iyT(1):p%iyT(2), p%iX1(1):p%iX1(2))) ! Group (1,2) - m%Jac(p%iJX2, p%iJT) = -m%dXdu(p%iX2Tight, p%iUTight) - - ! Group (2,2) - m%Jac(p%iJT, p%iJT) = m%G(p%iUTight, p%iUTight) - ! m%Jac(p%iJT, p%iJT) = m%dUdu(p%iUTight, p%iUTight) + & - ! matmul(m%dUdy(p%iUTight, p%iyTight), m%dYdu(p%iyTight, p%iUTight)) - - ! If modules in option 1 - if (size(p%iJ1) > 0) then - - ! Group (3,2) - m%Jac(p%iJ1, p%iJT) = m%dUdu(p%iUOpt1, p%iUTight) + & - matmul(m%dUdy(p%iUOpt1, p%iyTight), m%dYdu(p%iyTight, p%iUTight)) - ! Group (2,3) - m%Jac(p%iJT, p%iJ1) = m%dUdu(p%iUTight, p%iUOpt1) + & - matmul(m%dUdy(p%iUTight, p%iyOpt1), m%dYdu(p%iyOpt1, p%iUOpt1)) - ! Group (3,3) - m%Jac(p%iJ1, p%iJ1) = m%dUdu(p%iUOpt1, p%iUOpt1) + & - matmul(m%dUdy(p%iUOpt1, p%iyOpt1), m%dYdu(p%iyOpt1, p%iUOpt1)) - end if + m%Jac(p%iJX(1):p%iJX(2), p%iJUT(1):p%iJUT(2)) = -m%dXdu(p%iX2(1):p%iX2(2), p%iUT(1):p%iUT(2)) + + ! Group (2,2) - Inputs + m%Jac(p%iJU(1):p%iJU(2), p%iJU(1):p%iJU(2)) = m%G ! Condition jacobian matrix before factoring m%Jac(p%iJL, :) = m%Jac(p%iJL, :)/p%Scale_UJac m%Jac(:, p%iJL) = m%Jac(:, p%iJL)*p%Scale_UJac - ! if (munit == -1) then - ! call GetNewUnit(munit, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dUdu.bin", m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dUdy.bin", m%dUdy, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dXdu.bin", m%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dXdx.bin", m%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dYdu.bin", m%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "dYdx.bin", m%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "ED-dXdu.bin", Turbine%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "ED-dXdx.bin", Turbine%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "ED-dYdu.bin", Turbine%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! ! call DumpMatrix(munit, "ED-dYdx.bin", Turbine%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "G.bin", m%G, ErrStat2, ErrMsg2); if (Failed()) return - ! end if - ! call DumpMatrix(munit, "jacs/BD-dXdu-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "jacs/BD-dXdx-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "jacs/BD-dYdu-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "jacs/BD-dYdx-"//trim(num2lstr(iter))//".bin", Turbine%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return - ! call DumpMatrix(munit, "jacs/J-"//trim(num2lstr(iter))//".bin", m%Jac, ErrStat2, ErrMsg2); if (Failed()) return + ! Write debug matrices if requested + if (DebugJacobian) then + call BuildJacobian_Debug(m, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end if ! Factor jacobian matrix call LAPACK_getrf(size(m%Jac, 1), size(m%Jac, 1), m%Jac, m%IPIV, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return contains logical function Failed() @@ -1311,28 +1230,8 @@ logical function Failed() end function end subroutine -subroutine DumpMatrix(unit, filename, A, ErrStat, ErrMsg) - integer(IntKi), intent(in) :: unit - character(*), intent(in) :: filename - real(R8Ki), intent(in) :: A(:, :) - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'DumpMatrix' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = '' - - call OpenBOutFile(unit, filename, ErrStat2, ErrMsg2) - write (unit) int(shape(A), B4Ki) - write (unit) pack(A, .true.) - close (unit) -end subroutine - subroutine AddDeltaToStates(Mods, ModOrder, dx, x) - type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules + type(ModDataType), intent(in) :: Mods(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) real(R8Ki), intent(in) :: dx(:) real(R8Ki), intent(inout) :: x(:) @@ -1373,7 +1272,7 @@ subroutine AddDeltaToStates(Mods, ModOrder, dx, x) end subroutine subroutine AddDeltaToInputs(Mods, ModOrder, du, u) - type(ModDataType), intent(in) :: Mods(:) !< Solution variables from modules + type(ModDataType), intent(in) :: Mods(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) real(R8Ki), intent(in) :: du(:) real(R8Ki), intent(inout) :: u(:) @@ -1402,10 +1301,10 @@ subroutine AddDeltaToInputs(Mods, ModOrder, du, u) ! un(Var%iGblSol) = mod(u(Var%iGblSol) + du(Var%iGblSol), TwoPi_R8) u(Var%iGblSol) = u(Var%iGblSol) + du(Var%iGblSol) case (VF_Orientation) - ! Compose WM components (du is in radians) + ! Compose WM components (change in orientation with orientation) do k = 1, size(Var%iGblSol), 3 ind = Var%iGblSol(k:k + 2) - u(ind) = wm_compose(wm_from_xyz(du(ind)), u(ind)) ! du is in radians + u(ind) = wm_compose(wm_from_xyz(du(ind)), u(ind)) end do end select @@ -1414,35 +1313,76 @@ subroutine AddDeltaToInputs(Mods, ModOrder, du, u) end do end subroutine +subroutine ComputeDeltaU(Mods, ModOrder, PosAry, NegAry, DiffAry) + type(ModDataType), intent(in) :: Mods(:) ! Array of modules + integer(IntKi), intent(in) :: ModOrder(:) ! Array of module indices + real(R8Ki), intent(in) :: PosAry(:) ! Positive result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative result array + real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference + integer(IntKi) :: i, j, k, ind(3) + real(R8Ki) :: DeltaWM(3) + + ! Loop through module index order + do i = 1, size(ModOrder) + + ! Loop through input variables in module + do j = 1, size(Mods(ModOrder(i))%Vars%u) + + associate (Var => Mods(ModOrder(i))%Vars%u(j)) + + if (.not. allocated(Var%iGblSol)) cycle + + ! If variable field is orientation + if (Var%Field == VF_Orientation) then + + ! Loop through nodes + do k = 1, Var%Nodes, 3 + + ! Get vector of indicies of WM rotation parameters in array + ind = Var%iGblSol(k:k + 2) + + ! Compose WM parameters to go from negative to positive array + ! then store change in radians + DiffAry(ind) = wm_to_xyz(wm_compose(wm_inv(NegAry(ind)), PosAry(ind))) + end do + + else + + ! Subtract negative array from positive array + DiffAry(Var%iGblSol) = PosAry(Var%iGblSol) - NegAry(Var%iGblSol) + end if + end associate + end do + end do +end subroutine + subroutine PackModuleStates(ModData, this_state, T, x) - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules - integer(IntKi), intent(in) :: this_state !< State index - type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(R8Ki), allocatable, optional, intent(inout) :: x(:) - integer(IntKi) :: ii, j + type(ModDataType), intent(in) :: ModData(:) !< Module data + integer(IntKi), intent(in) :: this_state !< State index + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + real(R8Ki), intent(inout) :: x(:) + integer(IntKi) :: ii, j ! Must support all Tight Coupling modules - if (present(x)) then - do j = 1, size(ModData) - ii = ModData(j)%Ins - select case (ModData(j)%ID) - case (Module_ED) - call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) - call XferLocToGbl1D(ModData(j)%ixs, T%ED%m%Vals%x, x) - case (Module_BD) - call BD_PackStateValues(T%BD%p(ii), T%BD%x(ii, this_state), T%BD%m(ii)%Vals%x) - call XferLocToGbl1D(ModData(j)%ixs, T%BD%m(ii)%Vals%x, x) - case (Module_SD) - ! call SD_PackStateValues(SD%p, SD%x(this_state), SD%m%Vals%x) - ! x(SD%p%Vars%ix) = SD%m%Vals%x - end select - end do - end if + do j = 1, size(ModData) + ii = ModData(j)%Ins + select case (ModData(j)%ID) + case (Module_ED) + call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) + call XferLocToGbl1D(ModData(j)%ixs, T%ED%m%Vals%x, x) + case (Module_BD) + call BD_PackStateValues(T%BD%p(ii), T%BD%x(ii, this_state), T%BD%m(ii)%Vals%x) + call XferLocToGbl1D(ModData(j)%ixs, T%BD%m(ii)%Vals%x, x) + case (Module_SD) + ! call SD_PackStateValues(SD%p, SD%x(this_state), SD%m%Vals%x) + ! x(SD%p%Vars%ix) = SD%m%Vals%x + end select + end do end subroutine subroutine UnpackModuleStates(ModData, ModOrder, this_state, T, x) - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules + type(ModDataType), intent(in) :: ModData(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) integer(IntKi), intent(in) :: this_state !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -1453,11 +1393,9 @@ subroutine UnpackModuleStates(ModData, ModOrder, this_state, T, x) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) case (Module_ED) - call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) call XferGblToLoc1D(Mod%ixs, x, T%ED%m%Vals%x) call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(this_state)) case (Module_BD) - call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%m(Mod%Ins)%Vals%x) call XferGblToLoc1D(Mod%ixs, x, T%BD%m(Mod%Ins)%Vals%x) call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, this_state)) case (Module_SD) @@ -1468,98 +1406,212 @@ subroutine UnpackModuleStates(ModData, ModOrder, this_state, T, x) end subroutine ! PackModuleInputs packs input values from Option 1 modules -subroutine PackModuleInputs(ModData, ModOrder, T, u, u_tmp) - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules +subroutine PackModuleInputs(ModData, ModOrder, T, u) + type(ModDataType), intent(in) :: ModData(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(R8Ki), optional, intent(inout) :: u(:), u_tmp(:) + real(R8Ki), optional, intent(inout) :: u(:) integer(IntKi) :: j - if (present(u)) then - do j = 1, size(ModOrder) - associate (Mod => ModData(ModOrder(j))) - select case (Mod%ID) - case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) - call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) - case (Module_BD) - call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) - call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u) - case (Module_SD) - ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) - ! u(SD%p%Vars%iu) = SD%m%Vals%u - end select - end associate - end do - end if + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) + case (Module_BD) + call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) + call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u) + case (Module_SD) + ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) + ! u(SD%p%Vars%iu) = SD%m%Vals%u + end select + end associate + end do - if (present(u_tmp)) then - do j = 1, size(ModOrder) - associate (Mod => ModData(ModOrder(j))) - select case (Mod%ID) - case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%u, T%ED%m%Vals%u) - call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u_tmp) - case (Module_BD) - call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%u(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) - call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u_tmp) - case (Module_SD) - ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) - ! u(SD%p%Vars%iu) = SD%m%Vals%u - end select - end associate - end do - end if end subroutine -! PackModuleInputs packs input values from Option 1 modules -subroutine UnpackModuleInputs(ModData, ModOrder, T, u) - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules +! PackModuleUs packs U values from Option 1 modules +subroutine PackModuleUs(ModData, ModOrder, T, u) + type(ModDataType), intent(in) :: ModData(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(R8Ki), intent(in) :: u(:) + real(R8Ki), intent(inout) :: u(:) integer(IntKi) :: j do j = 1, size(ModOrder) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) - call XferGblToLoc1D(Mod%ius, u, T%ED%m%Vals%u) - call ED_UnpackInputValues(T%ED%p, T%ED%m%Vals%u, T%ED%Input(1)) + call ED_PackInputValues(T%ED%p, T%ED%u, T%ED%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) case (Module_BD) - call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) - call XferGblToLoc1D(Mod%ius, u, T%BD%m(Mod%Ins)%Vals%u) - call BD_UnpackInputValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u, T%BD%Input(1, Mod%Ins)) + call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%u(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) + call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u) case (Module_SD) - ! call SD_UnpackInputValues(SD%p, u(SD%p%Vars%iu), SD%Input(1)) + ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) + ! u(SD%p%Vars%iu) = SD%m%Vals%u end select end associate end do end subroutine -! PackModuleOutputs packs output values from Option 1 modules -subroutine PackModuleOutputs(ModData, ModOrder, T, y) - type(ModDataType), intent(in) :: ModData(:) !< Solution variables from modules - integer(IntKi), intent(in) :: ModOrder(:) +! UnpackModuleInputs unpacks input values from Option 1 modules +subroutine UnpackModuleInputs(ModData, ModOrder, T, u) + type(ModDataType), intent(in) :: ModData(:) !< Module data + integer(IntKi), intent(in) :: ModOrder(:) !< Module index array type(FAST_TurbineType), intent(inout) :: T !< Turbine type - real(R8Ki), intent(inout) :: y(:) + real(R8Ki), intent(in) :: u(:) integer(IntKi) :: j do j = 1, size(ModOrder) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) case (Module_ED) - call ED_PackOutputValues(T%ED%p, T%ED%y, T%ED%m%Vals%y) - call XferLocToGbl1D(Mod%iys, T%ED%m%Vals%y, y) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%ED%m%Vals%u) + call ED_UnpackInputValues(T%ED%p, T%ED%m%Vals%u, T%ED%Input(1)) case (Module_BD) - call BD_PackOutputValues(T%BD%p(Mod%Ins), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins)%Vals%y) - call XferLocToGbl1D(Mod%iys, T%BD%m(Mod%Ins)%Vals%y, y) + call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%BD%m(Mod%Ins)%Vals%u) + call BD_UnpackInputValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u, T%BD%Input(1, Mod%Ins)) + case (Module_SD) + ! call SD_UnpackInputValues(SD%p, u(SD%p%Vars%iu), SD%Input(1)) end select end associate end do end subroutine +!------------------------------------------------------------------------------- +! Debugging routines +!------------------------------------------------------------------------------- + +subroutine Solver_Init_Debug(p, m, Mods) + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(in) :: m !< Misc variables + type(ModDataType), intent(in) :: Mods(:) !< Module data + integer(IntKi) :: i, j + + write (DebugUn, '(A,*(I4))') " p%iJX2 = ", p%iJX + write (DebugUn, '(A,*(I4))') " p%iJUT = ", p%iJUT + write (DebugUn, '(A,*(I4))') " p%iJU = ", p%iJU + write (DebugUn, '(A,*(I4))') " p%iJL = ", p%iJL + write (DebugUn, '(A,*(I4))') " p%iX2 = ", p%iX2 + write (DebugUn, '(A,*(I4))') " p%iX1 = ", p%iX1 + write (DebugUn, '(A,*(I4))') " p%iUT = ", p%iUT + write (DebugUn, '(A,*(I4))') " p%iU1 = ", p%iU1 + write (DebugUn, '(A,*(I4))') " p%iyT = ", p%iyT + write (DebugUn, '(A,*(I4))') " p%iy1 = ", p%iy1 + write (DebugUn, *) "shape(m%dYdx) = ", shape(m%dYdx) + write (DebugUn, *) "shape(m%dYdu) = ", shape(m%dYdu) + write (DebugUn, *) "shape(m%dXdx) = ", shape(m%dXdx) + write (DebugUn, *) "shape(m%dXdu) = ", shape(m%dXdu) + write (DebugUn, *) "shape(m%dUdu) = ", shape(m%dUdu) + write (DebugUn, *) "shape(m%dUdy) = ", shape(m%dUdy) + + do i = 1, size(Mods) + write (DebugUn, *) "Module = ", Mods(i)%Abbr + write (DebugUn, *) "ModuleID = ", Mods(i)%ID + do j = 1, size(Mods(i)%Vars%x) + if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle + write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & + " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" + write (DebugUn, '(A,*(I4))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc + write (DebugUn, '(A,*(I4))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol + end do + do j = 1, size(Mods(i)%Vars%u) + if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle + write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & + " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" + write (DebugUn, '(A,*(I4))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc + write (DebugUn, '(A,*(I4))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol + end do + do j = 1, size(Mods(i)%Vars%y) + if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle + write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & + " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" + write (DebugUn, '(A,*(I4))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc + write (DebugUn, '(A,*(I4))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol + end do + end do +end subroutine + +subroutine Solver_Step_Debug(p, m, step, iterCorr, iterConv, delta_norm) + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(in) :: m !< Misc variables + integer(IntKi), intent(in) :: step, iterCorr, iterConv + real(R8Ki), intent(in) :: delta_norm + + write (DebugUn, *) "step = ", step + write (DebugUn, *) "iterCorr = ", iterCorr + write (DebugUn, *) "iterConv = ", iterConv + write (DebugUn, '(A,*(ES16.7))') " du = ", m%du + write (DebugUn, '(A,*(ES16.7))') " dx = ", m%dx + write (DebugUn, '(A,*(ES16.7))') " u = ", m%un + write (DebugUn, '(A,*(ES16.7))') " u_tmp = ", m%u_tmp + write (DebugUn, '(A,*(ES16.7))') " U = ", m%UDiff + write (DebugUn, '(A,*(ES16.7))') " x = ", m%xn + write (DebugUn, *) "delta_norm = ", delta_norm +end subroutine + +subroutine BuildJacobian_Debug(m, T, ErrStat, ErrMsg) + type(TC_MiscVarType), intent(in) :: m !< Misc variables + type(FAST_TurbineType), intent(in) :: T !< Turbine + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian_Debug' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + if (MatrixUn == -1) then + call GetNewUnit(MatrixUn, ErrStat2, ErrMsg2); if (Failed()) return + end if + + call DumpMatrix(MatrixUn, "dUdu.bin", m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "dUdy.bin", m%dUdy, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "dXdu.bin", m%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "dXdx.bin", m%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "dYdu.bin", m%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "dYdx.bin", m%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "ED-dXdu.bin", T%ED%m%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "ED-dXdx.bin", T%ED%m%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "ED-dYdu.bin", T%ED%m%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "ED-dYdx.bin", T%ED%m%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "G.bin", m%G, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "BD-dXdu.bin", T%BD%m(1)%Vals%dXdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "BD-dXdx.bin", T%BD%m(1)%Vals%dXdx, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "BD-dYdu.bin", T%BD%m(1)%Vals%dYdu, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "BD-dYdx.bin", T%BD%m(1)%Vals%dYdx, ErrStat2, ErrMsg2); if (Failed()) return + call DumpMatrix(MatrixUn, "J.bin", m%Jac, ErrStat2, ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine DumpMatrix(unit, filename, A, ErrStat, ErrMsg) + integer(IntKi), intent(in) :: unit + character(*), intent(in) :: filename + real(R8Ki), intent(in) :: A(:, :) + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'DumpMatrix' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + call OpenBOutFile(unit, filename, ErrStat2, ErrMsg2) + write (unit) int(shape(A), B4Ki) + write (unit) pack(A, .true.) + close (unit) +end subroutine + end module From d30ae7cc748e2eed6331fccfae44a38050e74eaa Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 6 Sep 2023 21:56:57 +0000 Subject: [PATCH 27/61] fix bug in cross product in ModVar --- modules/nwtc-library/src/ModVar.f90 | 36 ++++++++++++++--------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index a3edf351a8..57a430eb2e 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -884,28 +884,28 @@ pure function wm_from_dcm(R) result(c) pure function wm_to_xyz(c) result(xyz) real(R8Ki), intent(in) :: c(3) real(R8Ki) :: phi, n(3), xyz(3), m - m = sqrt(dot_product(c,c)) - if (m == 0.0_R8Ki) then - xyz = 0.0_R8Ki - return - end if - n = c/m - phi = 4.0_R8Ki*atan(m/4.0_R8Ki) - xyz = phi*n - ! xyz = c + ! m = sqrt(dot_product(c,c)) + ! if (m == 0.0_R8Ki) then + ! xyz = 0.0_R8Ki + ! return + ! end if + ! n = c/m + ! phi = 4.0_R8Ki*atan(m/4.0_R8Ki) + ! xyz = phi*n + xyz = c end function pure function wm_from_xyz(xyz) result(c) real(R8Ki), intent(in) :: xyz(3) real(R8Ki) :: phi, n(3), c(3) - phi = sqrt(dot_product(xyz,xyz)) - if (phi == 0.0_R8Ki) then - c = 0.0_R8Ki - return - end if - n = xyz / phi - c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n - ! c = xyz + ! phi = sqrt(dot_product(xyz,xyz)) + ! if (phi == 0.0_R8Ki) then + ! c = 0.0_R8Ki + ! return + ! end if + ! n = xyz / phi + ! c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n + c = xyz end function ! pure function wm_from_dcm(R) result(c) @@ -945,7 +945,7 @@ pure function wm_inv(c) result(cinv) pure function cross(a, b) result(c) real(R8Ki), intent(in) :: a(3), b(3) real(R8Ki) :: c(3) - c = [a(2)*b(3) - a(3)*b(2), -a(3)*b(1) + a(1)*b(3), a(1)*b(2) - a(2)*b(1)] + c = [a(2)*b(3) - a(3)*b(2), a(3)*b(1) - a(1)*b(3), a(1)*b(2) - b(1)*a(2)] end function end module From 9ed05f6e534f8a65ed5165ded479795c9601fd70 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 6 Sep 2023 21:57:22 +0000 Subject: [PATCH 28/61] More changes --- modules/openfast-library/src/FAST_Eval.f90 | 10 ++++++---- modules/openfast-library/src/Solver.f90 | 20 +++++++++++++------- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index aabeb99cdc..6ba0b6e042 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -308,10 +308,12 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) - ! Root node is always aligned with root motion mesh - T%BD%x(Mod%Ins, STATE_PRED)%q(:, 1) = 0.0_R8Ki - T%BD%x(Mod%Ins, STATE_PRED)%dqdt(1:3, 1) = matmul(T%BD%Input(1, Mod%Ins)%RootMotion%TranslationVel(:, 1), T%BD%OtherSt(1, Mod%Ins)%GlbRot) - T%BD%x(Mod%Ins, STATE_PRED)%dqdt(4:6, 1) = matmul(T%BD%Input(1, Mod%Ins)%RootMotion%RotationVel(:, 1), T%BD%OtherSt(1, Mod%Ins)%GlbRot) + ! Root node is always aligned with root motion mesh + associate (u_BD => T%BD%Input(1, Mod%Ins), x_BD => T%BD%x(Mod%Ins, STATE_PRED), OtherSt_BD => T%BD%OtherSt(1, Mod%Ins)) + x_BD%q(:, 1) = 0.0_R8Ki + x_BD%dqdt(1:3, 1) = matmul(u_BD%RootMotion%TranslationVel(:, 1), OtherSt_BD%GlbRot) + x_BD%dqdt(4:6, 1) = matmul(u_BD%RootMotion%RotationVel(:, 1), OtherSt_BD%GlbRot) + end associate case (Module_ED) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 1ab64a2785..1298e29d19 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -743,7 +743,7 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Initialize algorithmic acceleration from actual acceleration m%qn(:, COL_AA) = m%qn(:, COL_A) - m%q = m%qn + m%q = 0.0_R8Ki !---------------------------------------------------------------------------- ! Initialize module input and state arrays for interpolation/extrapolation @@ -828,11 +828,17 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM p%AlphaF*m%qn(:, COL_A) - & p%AlphaM*m%qn(:, COL_AA))/(1.0_R8Ki - p%AlphaM) - ! Calculate change in position and velocities - ! (position states include orientations which must be composed with deltas) - m%dq = 0.0_R8Ki - m%dq(:, COL_V) = p%DT*(1.0_R8Ki - p%Gamma)*m%qn(:, COL_AA) + p%DT*p%Gamma*m%q(:, COL_AA) - m%dq(:, COL_D) = p%DT*m%qn(:, COL_V) + p%DT**2*(0.5_R8Ki - p%Beta)*m%qn(:, COL_AA) + p%DT**2*p%Beta*m%q(:, COL_AA) + m%q(:, COL_D) = m%qn(:, COL_D) + & + p%DT*m%qn(:,COL_V) + & + p%DT**2*(0.5_R8Ki - p%Beta)*m%qn(:, COL_AA) + & + p%DT**2*p%Beta*m%q(:, COL_AA) + + m%q(:, COL_V) = m%qn(:, COL_V) + & + p%DT*(1.0_R8Ki - p%Gamma)*m%qn(:, COL_AA) + & + p%DT*p%Gamma*m%q(:, COL_AA) + + ! Calculate difference between new and old states + m%dq = m%q - m%qn ! Transfer delta state matrix to delta x array m%dx = 0.0_R8Ki @@ -1067,7 +1073,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do ! Update the global reference - ! call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg); if (Failed()) return + call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg); if (Failed()) return ! Update accelerations and algorithmic accelerations do j = 1, size(p_BD%Vars%x) From e928c259a6f1d8e003be99b39ebd7db994969970 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 31 Aug 2023 11:07:54 -0600 Subject: [PATCH 29/61] BD RefChange: minor corrections to reference frame. Still has a free energy problem. --- modules/beamdyn/src/BeamDyn.f90 | 61 ++++++++++++++++++++------------- 1 file changed, 38 insertions(+), 23 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 409754871a..6f894f9228 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -1059,9 +1059,12 @@ end subroutine InitRefFrame !----------------------------------------------------------------------------------------------------------------------------------- !> Set the global rotation information -- stored in OtherStates -subroutine SetRefFrame( u, OtherState, ErrStat, ErrMsg ) +!! This only works for u in the global frame!!!! +subroutine SetRefFrame( u, GlbPos, GlbRot, Glb_Crv, ErrStat, ErrMsg ) type(BD_InputType), intent(in ) :: u !< Inputs - type(BD_OtherStateType), intent(inout) :: OtherState !< Global rotations are stored in otherstate + real(R8Ki), intent( out) :: GlbPos(3) + real(R8Ki), intent( out) :: GlbRot(3,3) + real(R8Ki), intent( out) :: Glb_crv(3) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer(intKi) :: ErrStat2 ! temporary Error status @@ -1072,13 +1075,12 @@ subroutine SetRefFrame( u, OtherState, ErrStat, ErrMsg ) ErrMsg = "" ! Calculate new global position, rotation, and WM from root motion. Note that this is similar to the InitRefFrame routine - OtherState%GlbPos = u%RootMotion%Position(:, 1) + & - u%RootMotion%TranslationDisp(:, 1) - OtherState%GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) - !OtherState%Glb_crv = wm_from_dcm(OtherState%GlbRot) - CALL BD_CrvExtractCrv(OtherState%GlbRot, OtherState%Glb_crv, ErrStat2, ErrMsg2) + GlbPos = u%RootMotion%Position(:, 1) + & + u%RootMotion%TranslationDisp(:, 1) + GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) + !Glb_crv = wm_from_dcm(OtherState%GlbRot) + CALL BD_CrvExtractCrv(GlbRot, Glb_crv, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine SetRefFrame !----------------------------------------------------------------------------------------------------------------------------------- @@ -1981,8 +1983,8 @@ subroutine Init_OtherStates( u, p, OtherState, ErrStat, ErrMsg ) ! BJJ: not sure this should be used in CalcOutput when we are calculating Jacobians (this will alter the operating point of the continuous state) OtherState%RunQuasiStaticInit = .FALSE. - ! set the global position information - call SetRefFrame(u,OtherState,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! set the global position information -- u must be in the global frame for the SetRefFrame routine + call SetRefFrame(u, OtherState%GlbPos, OtherState%GlbRot, OtherState%Glb_Crv, ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end subroutine Init_OtherStates !----------------------------------------------------------------------------------------------------------------------------------- @@ -2331,6 +2333,10 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! LOCAL variables + real(R8Ki) :: GlbPos_new(3) + real(R8Ki) :: GlbRot_new(3,3) + real(R8Ki) :: GlbWM_new(3) + real(R8Ki) :: GlbWM_diff(3) INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcContStateDeriv' @@ -2364,11 +2370,19 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL BD_CopyContState(x, dxdt, MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Find the root position/rotation information at extrapolated u -- u must be in the global frame for the SetRefFrame routine + call SetRefFrame(u, GlbPos_new, GlbRot_new, GlbWM_new, ErrStat2,ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + ! Root displacement is relative to the GlbPos at time T, which is simply the difference between + ! the previous root position (GlbPos) and the new extrapolated position (Pos+TransDisp) dxdt%q(1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + & - matmul(m%u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) - CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, dxdt%q(4:6,1), ErrStat2, ErrMsg2) + matmul(m%u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) + CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, dxdt%q( 4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + dxdt%dqdt(1:3,1) = m%u%RootMotion%TranslationVel(:,1) dxdt%dqdt(4:6,1) = m%u%Rootmotion%RotationVel(:,1) @@ -4793,23 +4807,24 @@ SUBROUTINE BD_BoundaryGA2(x,p,u,OtherState, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + real(R8Ki) :: GlbPos_new(3) + real(R8Ki) :: GlbRot_new(3,3) + real(R8Ki) :: GlbWM_new(3) + real(R8Ki) :: GlbWM_diff(3) + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'BD_BoundaryGA2' ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - ! Root displacements - x%q(1:3,1) = u%RootMotion%TranslationDisp(1:3,1) + & - matmul(u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) - - ! Root rotations - CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1),p, OtherState, x%q(4:6,1), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - + ! NOTE: u is in a BD local frame. So cannot use SetRefFrame routine (note there are differences here) + x%q(1:3,1) = u%RootMotion%TranslationDisp(:,1) + & + matmul(u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) + CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1), p, OtherState, x%q( 4:6,1), ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return ! Root velocities/angular velocities and accelerations/angular accelerations x%dqdt(1:3,1) = u%RootMotion%TranslationVel(1:3,1) From 0ecd3c316ca2d22bc8d370ebc88e5a540c167daa Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 31 Aug 2023 17:01:01 -0600 Subject: [PATCH 30/61] BD RefChange: fix root node in mesh --- modules/beamdyn/src/BeamDyn_Subs.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index b601839a03..61ae592b1a 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -656,9 +656,10 @@ SUBROUTINE Set_BldMotion_NoAcc(p, x, OtherState, m, y) ! Calculate the translational displacement of each GLL node in the FAST coordinate system, ! referenced against the DCM of the blade root at T=0. - y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos - y%BldMotion%Position(1:3,temp_id2) + & - matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - +! y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos - y%BldMotion%Position(1:3,temp_id2) + & +! matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) + y%BldMotion%TranslationDisp(1:3,temp_id2) = OtherState%GlbPos + matmul(OtherState%GlbRot, p%uuN0(1:3, j, i) + x%q(1:3, temp_id)) - & + y%BldMotion%Position(1:3,temp_id2) !bjj: note differences here compared to BDrot_to_FASTdcm !adp: in BDrot_to_FASTdcm we are assuming that x%q(4:6,:) is zero because there is no rotatinoal displacement yet From d89a8ef959b484fa9674206ea8d8ef0ba9183c96 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 31 Aug 2023 17:23:30 -0600 Subject: [PATCH 31/61] BD RefChange: code cleanup. Add flag to get old behaviour --- modules/beamdyn/src/BeamDyn.f90 | 36 ++++++++++++++------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 6f894f9228..41ceceab52 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -53,6 +53,8 @@ MODULE BeamDyn PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT + ! do we change the reference frame at each State update? + LOGICAL, PARAMETER :: ChangeRefFrame=.true. CONTAINS @@ -2129,9 +2131,11 @@ SUBROUTINE BD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat CALL BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,''); if (ErrStat >= AbortErrLev) return - ! change reference frame to root motion at t=T+DT (u(1)%RootMotionMesh) - call BD_UpdateGlobalRef(u(1),p,x,OtherState,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'') + if (ChangeRefFrame) then + ! change reference frame to root motion at t=T+DT (u(1)%RootMotionMesh) + call BD_UpdateGlobalRef(u(1),p,x,OtherState,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'') + endif ELSE !IF(p%analysis_type == BD_STATIC_ANALYSIS) THEN CALL BD_Static( t, u, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) ENDIF @@ -2333,10 +2337,6 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! LOCAL variables - real(R8Ki) :: GlbPos_new(3) - real(R8Ki) :: GlbRot_new(3,3) - real(R8Ki) :: GlbWM_new(3) - real(R8Ki) :: GlbWM_diff(3) INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcContStateDeriv' @@ -2370,19 +2370,13 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL BD_CopyContState(x, dxdt, MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Find the root position/rotation information at extrapolated u -- u must be in the global frame for the SetRefFrame routine - call SetRefFrame(u, GlbPos_new, GlbRot_new, GlbWM_new, ErrStat2,ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - ! Root displacement is relative to the GlbPos at time T, which is simply the difference between ! the previous root position (GlbPos) and the new extrapolated position (Pos+TransDisp) dxdt%q(1:3,1) = m%u%RootMotion%TranslationDisp(:,1) + & matmul(m%u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) - CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, dxdt%q( 4:6,1), ErrStat2, ErrMsg2) + CALL ExtractRelativeRotation(m%u%RootMotion%Orientation(:,:,1), p, OtherState, dxdt%q(4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - dxdt%dqdt(1:3,1) = m%u%RootMotion%TranslationVel(:,1) dxdt%dqdt(4:6,1) = m%u%Rootmotion%RotationVel(:,1) @@ -4807,10 +4801,6 @@ SUBROUTINE BD_BoundaryGA2(x,p,u,OtherState, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(R8Ki) :: GlbPos_new(3) - real(R8Ki) :: GlbRot_new(3,3) - real(R8Ki) :: GlbWM_new(3) - real(R8Ki) :: GlbWM_diff(3) INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'BD_BoundaryGA2' @@ -4820,9 +4810,13 @@ SUBROUTINE BD_BoundaryGA2(x,p,u,OtherState, ErrStat, ErrMsg) ErrMsg = "" ! NOTE: u is in a BD local frame. So cannot use SetRefFrame routine (note there are differences here) - x%q(1:3,1) = u%RootMotion%TranslationDisp(:,1) + & + + ! Root displacements + x%q(1:3,1) = u%RootMotion%TranslationDisp(1:3,1) + & matmul(u%RootMotion%Position(:,1) - OtherState%GlbPos, OtherState%GlbRot) - CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1), p, OtherState, x%q( 4:6,1), ErrStat2, ErrMsg2) + + ! Root rotations + CALL ExtractRelativeRotation(u%RootMotion%Orientation(:,:,1),p, OtherState, x%q(4:6,1), ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -6745,7 +6739,7 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_UpdateGlobalRef' integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) real(R8Ki) :: GlbRot_old(3, 3), GlbRot_new(3, 3), GlbRot_diff(3, 3) real(R8Ki) :: GlbPos_old(3), GlbPos_new(3) From a78fed3de8676d8778c47857f9151d24dfb5b923 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 2 Sep 2023 11:58:15 +0000 Subject: [PATCH 32/61] Updating the BD global reference is working! --- modules/beamdyn/src/BeamDyn.f90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 41ceceab52..a2cdeee5eb 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -54,7 +54,7 @@ MODULE BeamDyn ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT ! do we change the reference frame at each State update? - LOGICAL, PARAMETER :: ChangeRefFrame=.true. + LOGICAL, PARAMETER :: ChangeRefFrame = .true. CONTAINS @@ -1080,9 +1080,9 @@ subroutine SetRefFrame( u, GlbPos, GlbRot, Glb_Crv, ErrStat, ErrMsg ) GlbPos = u%RootMotion%Position(:, 1) + & u%RootMotion%TranslationDisp(:, 1) GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) - !Glb_crv = wm_from_dcm(OtherState%GlbRot) CALL BD_CrvExtractCrv(GlbRot, Glb_crv, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL BD_CrvMatrixR(Glb_crv, GlbRot) end subroutine SetRefFrame !----------------------------------------------------------------------------------------------------------------------------------- @@ -2131,11 +2131,9 @@ SUBROUTINE BD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat CALL BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,''); if (ErrStat >= AbortErrLev) return - if (ChangeRefFrame) then - ! change reference frame to root motion at t=T+DT (u(1)%RootMotionMesh) - call BD_UpdateGlobalRef(u(1),p,x,OtherState,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'') - endif + ! change reference frame to root motion at t=T+DT (u(1)%RootMotionMesh) + call BD_UpdateGlobalRef(u(1),p,x,OtherState,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'') ELSE !IF(p%analysis_type == BD_STATIC_ANALYSIS) THEN CALL BD_Static( t, u, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) ENDIF @@ -6748,6 +6746,9 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" + ! If reference frame shouldn't be changed, return + if (.not. ChangeRefFrame) return + ! Save old global position, rotation, and WM GlbPos_old = OtherState%GlbPos GlbRot_old = OtherState%GlbRot From b9f9b2eeb506ae61acea62c0a51157caf728e6e0 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 12:31:36 +0000 Subject: [PATCH 33/61] Tight coupling with BeamDyn works! --- modules/openfast-library/src/FAST_Eval.f90 | 6 ------ modules/openfast-library/src/Solver.f90 | 22 +++++++++++++--------- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 6ba0b6e042..a1fdbf9435 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -308,12 +308,6 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) - ! Root node is always aligned with root motion mesh - associate (u_BD => T%BD%Input(1, Mod%Ins), x_BD => T%BD%x(Mod%Ins, STATE_PRED), OtherSt_BD => T%BD%OtherSt(1, Mod%Ins)) - x_BD%q(:, 1) = 0.0_R8Ki - x_BD%dqdt(1:3, 1) = matmul(u_BD%RootMotion%TranslationVel(:, 1), OtherSt_BD%GlbRot) - x_BD%dqdt(4:6, 1) = matmul(u_BD%RootMotion%RotationVel(:, 1), OtherSt_BD%GlbRot) - end associate case (Module_ED) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 1298e29d19..ab48471f32 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -26,9 +26,9 @@ module Solver integer(IntKi), parameter :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] ! Debugging -logical, parameter :: DebugSolver = .true. +logical, parameter :: DebugSolver = .false. integer(IntKi) :: DebugUn = -1 -logical, parameter :: DebugJacobian = .true. +logical, parameter :: DebugJacobian = .false. integer(IntKi) :: MatrixUn = -1 contains @@ -87,8 +87,8 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) pack([(i, i=1, size(Mods))], ModIDs == Module_HD), & pack([(i, i=1, size(Mods))], ModIDs == Module_Orca)] - ! Ordering array for BeamDyn modules - p%iModBD = [pack([(i, i=1, size(Mods))], ModIDs == Module_BD)] + ! Ordering array for BeamDyn modules + p%iModBD = [pack([(i, i=1, size(Mods))], ModIDs == Module_BD)] !---------------------------------------------------------------------------- ! Initialize mesh mappings (must be done before calculating global indices) @@ -411,7 +411,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Calculate generalized alpha parameters !---------------------------------------------------------------------------- - p%AccBlend = 0.0_R8Ki + p%AccBlend = 1.0_R8Ki p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) @@ -828,11 +828,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM p%AlphaF*m%qn(:, COL_A) - & p%AlphaM*m%qn(:, COL_AA))/(1.0_R8Ki - p%AlphaM) + ! Calculate displacements for the next step m%q(:, COL_D) = m%qn(:, COL_D) + & - p%DT*m%qn(:,COL_V) + & + p%DT*m%qn(:, COL_V) + & p%DT**2*(0.5_R8Ki - p%Beta)*m%qn(:, COL_AA) + & p%DT**2*p%Beta*m%q(:, COL_AA) - + + ! Calculate velocities for the next step m%q(:, COL_V) = m%qn(:, COL_V) + & p%DT*(1.0_R8Ki - p%Gamma)*m%qn(:, COL_AA) + & p%DT*p%Gamma*m%q(:, COL_AA) @@ -1017,7 +1019,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Add delta to x array to get new states (respect variable fields) call AddDeltaToStates(Mods, p%iModTC, m%dx, m%xn) - ! Overwrites state matrix values that were changed in AddDeltaToStates + ! Overwrites state matrix values that were changed in AddDeltaToStates call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) ! Transfer updated state to TC modules @@ -1091,9 +1093,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) call XferLocToGbl1D(Mod%ixs, m_BD%Vals%x, m%xn) end associate - end do + ! Update state matrix from state array + call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(p%iModAll) call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return From 7fbf6fc813f4a19bc88e81521e7d762e78765743 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:34:57 +0000 Subject: [PATCH 34/61] Add ModVars to InflowWind --- modules/inflowwind/src/InflowWind.f90 | 197 +++++++++++++------- modules/inflowwind/src/InflowWind.txt | 6 +- modules/inflowwind/src/InflowWind_Subs.f90 | 4 + modules/inflowwind/src/InflowWind_Types.f90 | 84 +++++++++ 4 files changed, 224 insertions(+), 67 deletions(-) diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 85ef702577..07c48d5642 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -143,8 +143,6 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons INTEGER(IntKi) :: SumFileUnit !< Unit number for the summary file CHARACTER(256) :: SumFileName !< Name of the summary file CHARACTER(256) :: EchoFileName !< Name of the summary file - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - CHARACTER(1), PARAMETER :: XYZ(3) = (/'X','Y','Z'/) INTEGER(IntKi) :: TmpErrStat CHARACTER(ErrMsgLen) :: TmpErrMsg !< temporary error message @@ -582,75 +580,16 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons InitOutData%WriteOutputUnt = p%OutParam(1:p%NumOuts)%Units !---------------------------------------------------------------------------- - ! Linearization + ! Module Variables !---------------------------------------------------------------------------- - - ! allocate and fill variables for linearization - if (InitInp%Linearize) then - - ! If field is uniform and there is any nonzero upflow, return error - ! Math needs work before this can be implemented - if (p%FlowField%FieldType == Uniform_FieldType) then - if (any(p%FlowField%Uniform%AngleV /= 0.0_ReKi)) then - call SetErrStat(ErrID_Fatal, 'Upflow in uniform wind files must be 0 for linearization analysis in InflowWind.', ErrStat, ErrMsg, RoutineName) - call Cleanup() - return - end if - end if - ! also need to add InputGuess%HubOrientation to the u%Linear items - CALL AllocAry(InitOutData%LinNames_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'LinNames_u', TmpErrStat, TmpErrMsg) ! add hub position, orientation(3) + extended inputs - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%RotFrame_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'RotFrame_u', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%IsLoad_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'IsLoad_u', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%LinNames_y, InitInp%NumWindPoints*3 + size(y%DiskVel) + p%NumOuts, 'LinNames_y', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%RotFrame_y, InitInp%NumWindPoints*3 + size(y%DiskVel) + p%NumOuts, 'RotFrame_y', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN + CALL Init_ModuleVars(InitInp, InputGuess, p, y, m, InitOutData, InputFileData, TmpErrStat, TmpErrMsg) + CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat>= AbortErrLev ) THEN CALL Cleanup() RETURN ENDIF - do i=1,InitInp%NumWindPoints - do j=1,3 - InitOutData%LinNames_y((i-1)*3+j) = UVW(j)//'-component inflow velocity at node '//trim(num2lstr(i))//', m/s' - InitOutData%LinNames_u((i-1)*3+j) = XYZ(j)//'-component position of node '//trim(num2lstr(i))//', m' - end do - end do - - ! hub position - Lin_Indx = InitInp%NumWindPoints*3 - do j=1,3 - InitOutData%LinNames_y(Lin_Indx+j) = 'average '//UVW(j)//'-component rotor-disk velocity, m/s' - InitOutData%LinNames_u(Lin_Indx+j) = XYZ(j)//'-component position of moving hub, m' - end do - Lin_Indx = Lin_Indx + 3 - - ! hub orientation angles - do j=1,3 - InitOutData%LinNames_u(Lin_Indx+j) = XYZ(j)//' orientation of moving hub, rad' - end do - Lin_Indx = Lin_Indx + 3 - - InitOutData%LinNames_u(Lin_Indx + 1) = 'Extended input: horizontal wind speed (steady/uniform wind), m/s' - InitOutData%LinNames_u(Lin_Indx + 2) = 'Extended input: vertical power-law shear exponent, -' - InitOutData%LinNames_u(Lin_Indx + 3) = 'Extended input: propagation direction, rad' - - do i=1,p%NumOuts - InitOutData%LinNames_y(i+3*InitInp%NumWindPoints+size(y%DiskVel)) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - ! IfW inputs and outputs are in the global, not rotating frame - InitOutData%RotFrame_u = .false. - InitOutData%RotFrame_y = .false. - - InitOutData%IsLoad_u = .false. ! IfW inputs for linearization are not loads - - end if - ! Set the version information in InitOutData InitOutData%Ver = IfW_Ver @@ -678,6 +617,134 @@ END SUBROUTINE CleanUp END SUBROUTINE InflowWind_Init +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ErrMsg) + TYPE(InflowWind_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(InflowWind_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(InflowWind_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(InflowWind_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + TYPE(InflowWind_InputFile), INTENT(IN ) :: InputFileData !< Input file data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) + CHARACTER(1), PARAMETER :: XYZ(3) = (/'X','Y','Z'/) + integer(IntKi) :: i, j, flags + REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + TYPE(ModVarType) :: Var + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Associate pointers in initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Wind points + do i = 1, InitInp%NumWindPoints + call MV_AddVar(p%Vars%u, 'node '//trim(num2lstr(i))//' position', VF_Scalar, Num=3, & + LinNames=[(XYZ(j)//'-component position of node '//trim(num2lstr(i))//', m', j=1,3)]) + end do + + ! Hub + call MV_AddVar(p%Vars%u, 'hub position', VF_Scalar, Num=3, & + LinNames=[(XYZ(j)//'-component position of moving hub, m', j=1,3)]) + call MV_AddVar(p%Vars%u, 'hub orientation', VF_Scalar, Num=3, & + LinNames=[(XYZ(j)//' orientation of moving hub, rad', j=1,3)]) + + ! Extended + call MV_AddVar(p%Vars%u, 'VelH', VF_Scalar, Flags=VF_Ext, & + LinNames=['Extended input: horizontal wind speed (steady/uniform wind), m/s']) + call MV_AddVar(p%Vars%u, 'ShrExp', VF_Scalar, Flags=VF_Ext, & + LinNames=['Extended input: vertical power-law shear exponent, -']) + call MV_AddVar(p%Vars%u, 'PropDir', VF_Scalar, Flags=VF_Ext, & + LinNames=['Extended input: propagation direction, rad']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Inflow velocity at wind points + do i = 1, InitInp%NumWindPoints + call MV_AddVar(p%Vars%y, 'node '//trim(num2lstr(i))//' inflow', VF_Scalar, Num=3, & + LinNames=[(UVW(j)//'-component inflow velocity at node '//trim(num2lstr(i))//', m/s', j=1,3)]) + end do + + ! Average rotor disk velocity + call MV_AddVar(p%Vars%y, 'avg rotor disk velocity', VF_Scalar, Num=3, & + LinNames=[('average '//UVW(j)//'-component rotor-disk velocity, m/s', j=1,3)]) + + ! Outputs + do i = 1, p%NumOuts + call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, Num=p%NumOuts, & + LinNames=[trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units]) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + if (.not. InitInp%Linearize) return + + ! If field is uniform and there is any nonzero upflow, return error + ! Math needs work before this can be implemented + if (p%FlowField%FieldType == Uniform_FieldType) then + if (any(p%FlowField%Uniform%AngleV /= 0.0_ReKi)) then + call SetErrStat(ErrID_Fatal, 'Upflow in uniform wind files must be 0 for linearization analysis in InflowWind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%Num + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + CALL AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%Num + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 + end do + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine !==================================================================================================== !> This routine takes an input dataset of type InputType which contains a position array of dimensions 3*n. It then calculates diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index be54b9604b..7c6c76b614 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -113,8 +113,8 @@ typedef ^ ^ CHARACTER(LinChanLen) LinNam typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - - +typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - +typedef ^ ^ ModVarsType *Vars - - - "Module Variables" # ..... Parameters ................................................................................................................ # Define parameters here: @@ -131,6 +131,7 @@ typedef ^ ^ OutParmType OutParam typedef ^ ^ IntKi OutParamLinIndx {:}{:} - - "Index into WriteOutput for WindViXYZ in linearization analysis" - typedef ^ ^ lidar_ParameterType lidar - - - "Lidar parameter data" - typedef ^ ^ LOGICAL OutputAccel - .FALSE. - "Flag to output wind acceleration" - +typedef ^ ^ ModVarsType &Vars - - - "Module Variables" - # ..... Inputs .................................................................................................................... @@ -167,3 +168,4 @@ typedef ^ ^ InflowWind_InputType u_Avg typedef ^ ^ InflowWind_OutputType y_Avg - - - "outputs for computing rotor-averaged values" - typedef ^ ^ InflowWind_InputType u_Hub - - - "inputs for computing hub values" - typedef ^ ^ InflowWind_OutputType y_Hub - - - "outputs for computing hub values" - +typedef ^ ^ ModValsType Vals - - - "Values corresponding to module variables" diff --git a/modules/inflowwind/src/InflowWind_Subs.f90 b/modules/inflowwind/src/InflowWind_Subs.f90 index 517aa1096f..4dd9e2a86a 100644 --- a/modules/inflowwind/src/InflowWind_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Subs.f90 @@ -25,7 +25,11 @@ MODULE InflowWind_Subs IMPLICIT NONE + PRIVATE + PUBLIC :: CalculateOutput, InflowWind_GetRotorSpatialAverage, InflowWind_GetHubValues, & + InflowWind_CloseSumFile, InflowWind_ParseInputFileInfo, SetAllOuts, & + InflowWind_OpenSumFile, InflowWind_SetParameters, InflowWind_ValidateInput ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 7a7347bce5..3756b289ae 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -134,6 +134,7 @@ MODULE InflowWind_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE InflowWind_InitOutputType ! ======================= ! ========= InflowWind_ParameterType ======= @@ -150,6 +151,7 @@ MODULE InflowWind_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for WindViXYZ in linearization analysis [-] TYPE(Lidar_ParameterType) :: lidar !< Lidar parameter data [-] LOGICAL :: OutputAccel = .FALSE. !< Flag to output wind acceleration [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE InflowWind_ParameterType ! ======================= ! ========= InflowWind_InputType ======= @@ -199,6 +201,7 @@ MODULE InflowWind_Types TYPE(InflowWind_OutputType) :: y_Avg !< outputs for computing rotor-averaged values [-] TYPE(InflowWind_InputType) :: u_Hub !< inputs for computing hub values [-] TYPE(InflowWind_OutputType) :: y_Hub !< outputs for computing hub values [-] + TYPE(ModValsType) :: Vals !< Values corresponding to module variables [-] END TYPE InflowWind_MiscVarType ! ======================= CONTAINS @@ -877,6 +880,7 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if DstInitOutputData%FlowField => SrcInitOutputData%FlowField + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -914,6 +918,7 @@ subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%IsLoad_u) end if nullify(InitOutputData%FlowField) + nullify(InitOutputData%Vars) end subroutine subroutine InflowWind_PackInitOutput(Buf, Indata) @@ -966,6 +971,13 @@ subroutine InflowWind_PackInitOutput(Buf, Indata) call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) end if end if + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1099,6 +1111,26 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) else OutData%FlowField => null() end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1198,6 +1230,18 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstParamData%OutputAccel = SrcParamData%OutputAccel + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if end subroutine subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1240,6 +1284,12 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) end if call Lidar_DestroyParam(ParamData%lidar, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if end subroutine subroutine InflowWind_PackParam(Buf, Indata) @@ -1292,6 +1342,13 @@ subroutine InflowWind_PackParam(Buf, Indata) end if call Lidar_PackParam(Buf, InData%lidar) call RegPack(Buf, InData%OutputAccel) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1408,6 +1465,26 @@ subroutine InflowWind_UnPackParam(Buf, OutData) call Lidar_UnpackParam(Buf, OutData%lidar) ! lidar call RegUnpack(Buf, OutData%OutputAccel) if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1878,6 +1955,9 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM call InflowWind_CopyOutput(SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1906,6 +1986,8 @@ subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call InflowWind_DestroyOutput(MiscData%y_Hub, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackMisc(Buf, Indata) @@ -1932,6 +2014,7 @@ subroutine InflowWind_PackMisc(Buf, Indata) call InflowWind_PackOutput(Buf, InData%y_Avg) call InflowWind_PackInput(Buf, InData%u_Hub) call InflowWind_PackOutput(Buf, InData%y_Hub) + call NWTC_Library_PackModValsType(Buf, InData%Vals) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1989,6 +2072,7 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) call InflowWind_UnpackOutput(Buf, OutData%y_Avg) ! y_Avg call InflowWind_UnpackInput(Buf, OutData%u_Hub) ! u_Hub call InflowWind_UnpackOutput(Buf, OutData%y_Hub) ! y_Hub + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals end subroutine subroutine InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) From 0c630d29fd4cbc1a718bef6766573852c1925772 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:35:57 +0000 Subject: [PATCH 35/61] Remove check for Module ID in FAST_ResetRemapFlags --- modules/openfast-library/src/FAST_Eval.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index a1fdbf9435..520c37c804 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -930,9 +930,6 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) ! case (Module_SrvD) - case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) - return end select contains From f2a32fcae5bf05c82f0f631136b5f12c55952325 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:37:51 +0000 Subject: [PATCH 36/61] Add missing public funcs in BD --- modules/beamdyn/src/BeamDyn.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index a2cdeee5eb..7202873b23 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -53,6 +53,9 @@ MODULE BeamDyn PUBLIC :: BD_UpdateGlobalRef !< update the BeamDyn reference. The reference for the calculations follows u%RootMotionMesh ! and therefore x%q must be updated from T -> T+DT to include the root motion from T->T+DT + PUBLIC :: BD_PackStateValues, BD_UnpackStateValues + PUBLIC :: BD_PackInputValues, BD_UnpackInputValues + ! do we change the reference frame at each State update? LOGICAL, PARAMETER :: ChangeRefFrame = .true. From 6fa22bb9f0649f6e7836e75dc1021a814230f2f6 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:38:43 +0000 Subject: [PATCH 37/61] Add consts, remove unused array in FAST_Registry --- .../openfast-library/src/FAST_Registry.txt | 3 +- modules/openfast-library/src/FAST_Types.f90 | 37 +------------------ 2 files changed, 2 insertions(+), 38 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c631e81231..f0a5234ebd 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -125,7 +125,7 @@ typedef ^ ^ R8Ki AlphaM - - - typedef ^ ^ R8Ki AlphaF - - - "Generalized-alpha alpha_f coefficient" - typedef ^ ^ R8Ki Beta - - - "Generalized-alpha beta coefficient" - typedef ^ ^ R8Ki Gamma - - - "Generalized-alpha gamma coefficient" - -typedef ^ ^ R8Ki C 3 - - "Generalized-alpha coefficient array" - +typedef ^ ^ R8Ki C 7 - - "Generalized-alpha coefficient array" - typedef ^ ^ IntKi iX1 2 - - "" - typedef ^ ^ IntKi iX2 2 - - "" - typedef ^ ^ IntKi iUT 2 - - "" - @@ -166,7 +166,6 @@ typedef ^ ^ R8Ki XB :: - - typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - typedef ^ ^ R8Ki Jac :: - - "" - typedef ^ ^ IntKi IPIV : - - "" - -typedef ^ ^ IntKi IPIV2 : - - "" - typedef ^ ^ IntKi IterTotal - 0 - "" - typedef ^ ^ IntKi IterUntilUJac - 0 - "Number of convergence iterations until Jacobian update" - typedef ^ ^ IntKi StepsUntilUJac - 0 - "Number of time steps until Jacobian update" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 12f65a8f41..386e43266d 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -147,7 +147,7 @@ MODULE FAST_Types REAL(R8Ki) :: AlphaF = 0.0_R8Ki !< Generalized-alpha alpha_f coefficient [-] REAL(R8Ki) :: Beta = 0.0_R8Ki !< Generalized-alpha beta coefficient [-] REAL(R8Ki) :: Gamma = 0.0_R8Ki !< Generalized-alpha gamma coefficient [-] - REAL(R8Ki) , DIMENSION(1:3) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] + REAL(R8Ki) , DIMENSION(1:7) :: C = 0.0_R8Ki !< Generalized-alpha coefficient array [-] INTEGER(IntKi) , DIMENSION(1:2) :: iX1 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iX2 = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(1:2) :: iUT = 0_IntKi !< [-] @@ -190,7 +190,6 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: G !< Used to merge state matrices [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Jac !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IPIV2 !< [-] INTEGER(IntKi) :: IterTotal = 0 !< [-] INTEGER(IntKi) :: IterUntilUJac = 0 !< Number of convergence iterations until Jacobian update [-] INTEGER(IntKi) :: StepsUntilUJac = 0 !< Number of time steps until Jacobian update [-] @@ -2360,18 +2359,6 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if DstTC_MiscVarTypeData%IPIV = SrcTC_MiscVarTypeData%IPIV end if - if (allocated(SrcTC_MiscVarTypeData%IPIV2)) then - LB(1:1) = lbound(SrcTC_MiscVarTypeData%IPIV2) - UB(1:1) = ubound(SrcTC_MiscVarTypeData%IPIV2) - if (.not. allocated(DstTC_MiscVarTypeData%IPIV2)) then - allocate(DstTC_MiscVarTypeData%IPIV2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_MiscVarTypeData%IPIV2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstTC_MiscVarTypeData%IPIV2 = SrcTC_MiscVarTypeData%IPIV2 - end if DstTC_MiscVarTypeData%IterTotal = SrcTC_MiscVarTypeData%IterTotal DstTC_MiscVarTypeData%IterUntilUJac = SrcTC_MiscVarTypeData%IterUntilUJac DstTC_MiscVarTypeData%StepsUntilUJac = SrcTC_MiscVarTypeData%StepsUntilUJac @@ -2515,9 +2502,6 @@ subroutine FAST_DestroyTC_MiscVarType(TC_MiscVarTypeData, ErrStat, ErrMsg) if (allocated(TC_MiscVarTypeData%IPIV)) then deallocate(TC_MiscVarTypeData%IPIV) end if - if (allocated(TC_MiscVarTypeData%IPIV2)) then - deallocate(TC_MiscVarTypeData%IPIV2) - end if if (allocated(TC_MiscVarTypeData%dq)) then deallocate(TC_MiscVarTypeData%dq) end if @@ -2653,11 +2637,6 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%IPIV), ubound(InData%IPIV)) call RegPack(Buf, InData%IPIV) end if - call RegPack(Buf, allocated(InData%IPIV2)) - if (allocated(InData%IPIV2)) then - call RegPackBounds(Buf, 1, lbound(InData%IPIV2), ubound(InData%IPIV2)) - call RegPack(Buf, InData%IPIV2) - end if call RegPack(Buf, InData%IterTotal) call RegPack(Buf, InData%IterUntilUJac) call RegPack(Buf, InData%StepsUntilUJac) @@ -2996,20 +2975,6 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%IPIV) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%IPIV2)) deallocate(OutData%IPIV2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IPIV2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IPIV2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IPIV2) - if (RegCheckErr(Buf, RoutineName)) return - end if call RegUnpack(Buf, OutData%IterTotal) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%IterUntilUJac) From 17b3054f4fbebadc1c79f352523d7ca66ffe8e83 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:41:22 +0000 Subject: [PATCH 38/61] Solver cleanup, add modules to index arrays --- modules/openfast-library/src/Solver.f90 | 311 ++++++++++++++---------- 1 file changed, 182 insertions(+), 129 deletions(-) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index ab48471f32..b24495bb09 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -28,6 +28,7 @@ module Solver ! Debugging logical, parameter :: DebugSolver = .false. integer(IntKi) :: DebugUn = -1 +character(*), parameter :: DebugFile = 'solver.dbg' logical, parameter :: DebugJacobian = .false. integer(IntKi) :: MatrixUn = -1 @@ -46,60 +47,186 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 ! local error message integer(IntKi) :: i, j, k, n integer(IntKi) :: NumX, NumQ, NumU, NumY, NumJ - integer(IntKi), allocatable :: modIDs(:), vec1(:), vec2(:), iuLoad(:) + integer(IntKi), allocatable :: modIDs(:), modInds(:) type(TC_MappingType) :: MeshMap !---------------------------------------------------------------------------- ! Module ordering for solve !---------------------------------------------------------------------------- + ! Create array of indices for Mods array + modInds = [(i, i=1, size(Mods))] + ! Get array of module IDs modIDs = [(Mods(i)%ID, i=1, size(Mods))] - ! Ordering array for all modules - p%iModAll = [pack([(i, i=1, size(Mods))], ModIDs == Module_SrvD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_AD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & - pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_SD)] - - ! Ordering array for tight coupling modules - p%iModTC = [pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & - pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_SD)] - - ! Ordering array for Option 2 solve - p%iModOpt2 = [pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & - pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_SD)] - - ! Ordering array for Option 1 solve - p%iModOpt1 = [pack([(i, i=1, size(Mods))], ModIDs == Module_ED), & - pack([(i, i=1, size(Mods))], ModIDs == Module_BD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_SD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_ExtPtfm), & - pack([(i, i=1, size(Mods))], ModIDs == Module_HD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_Orca)] - - ! Ordering array for Option 1 modules that were not in Option 2 + ! Indicies of all modules + p%iModAll = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD)] + + ! Indicies of tight coupling modules + p%iModTC = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD)] + + ! Indicies of Option 2 modules + p%iModOpt2 = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_FEAM), & + pack(modInds, ModIDs == Module_IceD), & + pack(modInds, ModIDs == Module_IceF), & + pack(modInds, ModIDs == Module_MAP), & + pack(modInds, ModIDs == Module_MD)] + + ! Indicies of Option 1 modules + p%iModOpt1 = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_ExtPtfm), & + pack(modInds, ModIDs == Module_HD), & + pack(modInds, ModIDs == Module_Orca)] + + ! Indicies of Option 1 modules that were not in Option 2 ! These modules need to do update states and calc output before Option 1 solve - p%iModOpt1US = [pack([(i, i=1, size(Mods))], ModIDs == Module_ExtPtfm), & - pack([(i, i=1, size(Mods))], ModIDs == Module_HD), & - pack([(i, i=1, size(Mods))], ModIDs == Module_Orca)] + p%iModOpt1US = [pack(modInds, ModIDs == Module_ExtPtfm), & + pack(modInds, ModIDs == Module_HD), & + pack(modInds, ModIDs == Module_Orca)] - ! Ordering array for BeamDyn modules - p%iModBD = [pack([(i, i=1, size(Mods))], ModIDs == Module_BD)] + ! Indices of BeamDyn modules + p%iModBD = [pack(modInds, ModIDs == Module_BD)] !---------------------------------------------------------------------------- ! Initialize mesh mappings (must be done before calculating global indices) !---------------------------------------------------------------------------- - call Solver_DefineMappings(m%Mappings, Mods, ErrStat2, ErrMsg2) + call DefineMappings(m%Mappings, Mods, ErrStat2, ErrMsg2) + if (Failed()) return + + !---------------------------------------------------------------------------- + ! Calculate variable global indices and related index arrays + !---------------------------------------------------------------------------- + + call CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat2, ErrMsg2) if (Failed()) return !---------------------------------------------------------------------------- - ! Calculate state variable global indices and transfer index arrays - ! for tight coupling modules + ! Allocate state, input, and output storage + !---------------------------------------------------------------------------- + + ! State arrays + call AllocAry(m%x, NumX, "m%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%xn, NumX, "m%xn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dx, NumX, "m%dx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dxdt, NumX, "m%dxdt", ErrStat2, ErrMsg2); if (Failed()) return + + ! State matrices + call AllocAry(m%q, NumQ, 4, "m%q", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%qn, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dq, NumQ, 4, "m%dq", ErrStat2, ErrMsg2); if (Failed()) return + + ! Inputs array + call AllocAry(m%u, NumU, "m%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%un, NumU, "m%un", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%du, NumU, "m%du", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%u_tmp, NumU, "m%u_tmp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%UDiff, NumU, "m%UDiff", ErrStat2, ErrMsg2); if (Failed()) return + + ! Output arrays + call AllocAry(m%y, NumY, "m%y", ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Allocate Jacobian matrices + !---------------------------------------------------------------------------- + + call AllocAry(m%dYdx, NumY, NumX, "m%dYdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dYdu, NumY, NumU, "m%dYdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dXdx, NumX, NumX, "m%dXdx", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dXdu, NumX, NumU, "m%dXdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dUdu, NumU, NumU, "m%dUdu", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%dUdy, NumU, NumY, "m%dUdy", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(m%G, NumU, NumU, "m%G", ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Allocate solver Jacobian matrix and right hand side + !---------------------------------------------------------------------------- + + ! Allocate Jacobian matrix, RHS/X matrix, Pivot array + call AllocAry(m%Jac, NumJ, NumJ, "m%Jac", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%XB, NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return + call AllocAry(m%IPIV, NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return + m%Jac = 0.0_R8Ki + + ! Initialize iterations and steps until Jacobian is calculated to zero + ! so it is calculated in first step + m%IterUntilUJac = 0 + m%StepsUntilUJac = 0 + + !---------------------------------------------------------------------------- + ! Calculate generalized alpha parameters + !---------------------------------------------------------------------------- + + ! Acceleration blending term between current and next value, used during + ! state prediction (1.0 = constant acceleration, 0.0 = no acceleration). + p%AccBlend = 1.0_R8Ki + + p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) + p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) + p%Gamma = 0.5_R8Ki - p%AlphaM + p%AlphaF + p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2.0_R8Ki/4.0_R8Ki + + ! Constants used in Jacobian construction and state prediction + p%C(1) = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) + p%C(2) = p%DT*p%Gamma*p%C(1) + p%C(3) = p%DT**2*p%Beta*p%C(1) + p%C(4) = p%DT**2*(0.5_R8Ki - p%Beta) + p%C(5) = p%DT**2*p%Beta + p%C(6) = p%DT*(1.0_R8Ki - p%Gamma) + p%C(7) = p%DT*p%Gamma + + !---------------------------------------------------------------------------- + ! Write debug info to file + !---------------------------------------------------------------------------- + + if (DebugSolver) then + call GetNewUnit(DebugUn, ErrStat2, ErrMsg2); if (Failed()) return + call OpenFOutFile(DebugUn, DebugFile, ErrStat2, ErrMsg2); if (Failed()) return + call Solver_Init_Debug(p, m, Mods) + end if + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ErrMsg) + type(TC_ParameterType), intent(inout) :: p !< Parameters + type(ModDataType), intent(inout) :: Mods(:) !< Module data + integer(IntKi), intent(out) :: NumX, NumU, NumY, NumQ, NumJ + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Solver_Init' + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + integer(IntKi), allocatable :: modIDs(:), vec1(:), vec2(:), iuLoad(:) + integer(IntKi) :: i, j, k, n + + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Calculate state variable global indices and transfer arrays + ! for tight coupling and option one modules !---------------------------------------------------------------------------- ! Initialize number of state variables to zero @@ -196,7 +323,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) end do end do - ! Calculate number of option 1 inputs + ! Save number of option 1 inputs p%iU1 = [p%iUT(2) + 1, NumU] ! Loop through all modules @@ -338,49 +465,11 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) end do - ! Remove x->q indicies that aren't set + ! Remove unused x->q indicies p%ixqd = p%ixqd(:, 1:n) !---------------------------------------------------------------------------- - ! Allocate state and input storage - !---------------------------------------------------------------------------- - - ! State, State delta, and State Derivative - call AllocAry(m%x, NumX, "m%x", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%xn, NumX, "m%xn", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dx, NumX, "m%dx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dxdt, NumX, "m%dxdt", ErrStat2, ErrMsg2); if (Failed()) return - - ! Inputs and Input Temporary - call AllocAry(m%u, NumU, "m%u", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%un, NumU, "m%un", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%du, NumU, "m%du", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%u_tmp, NumU, "m%u_tmp", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%UDiff, NumU, "m%UDiff", ErrStat2, ErrMsg2); if (Failed()) return - - ! Outputs - call AllocAry(m%y, NumY, "m%y", ErrStat2, ErrMsg2); if (Failed()) return - - ! Allocate/initialize global q storage - call AllocAry(m%q, NumQ, 4, "m%q", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%qn, NumQ, 4, "m%qn", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dq, NumQ, 4, "m%dq", ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Allocate Jacobian matrices - !---------------------------------------------------------------------------- - - call AllocAry(m%dYdx, NumY, NumX, "m%dYdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dYdu, NumY, NumU, "m%dYdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dXdx, NumX, NumX, "m%dXdx", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dXdu, NumX, NumU, "m%dXdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dUdu, NumU, NumU, "m%dUdu", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%dUdy, NumU, NumY, "m%dUdy", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%G, NumU, NumU, "m%G", ErrStat2, ErrMsg2); if (Failed()) return - call AllocAry(m%IPIV2, NumU, "m%IPIV2", ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Allocate solver Jacobian matrix, RHS, and Delta + ! Jacobian indices and ranges !---------------------------------------------------------------------------- ! Calculate size of Jacobian matrix @@ -396,42 +485,6 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Get Jacobian indicies containing loads p%iJL = iuLoad + NumQ - ! Allocate Macobian matrix, RHS/X matrix, Pivot array - call AllocAry(m%Jac, NumJ, NumJ, "m%Jac", ErrStat, ErrMsg); if (Failed()) return - call AllocAry(m%XB, NumJ, 1, "m%XB", ErrStat, ErrMsg); if (Failed()) return - call AllocAry(m%IPIV, NumJ, "m%IPIV", ErrStat, ErrMsg); if (Failed()) return - m%Jac = 0.0_R8Ki - - ! Initialize iterations and steps until Jacobian is calculated to zero - ! so it will be calculated in first step - m%IterUntilUJac = 0 - m%StepsUntilUJac = 0 - - !---------------------------------------------------------------------------- - ! Calculate generalized alpha parameters - !---------------------------------------------------------------------------- - - p%AccBlend = 1.0_R8Ki - - p%AlphaM = (2.0_R8Ki*p%RhoInf - 1.0_R8Ki)/(p%RhoInf + 1.0_R8Ki) - p%AlphaF = p%RhoInf/(p%RhoInf + 1.0_R8Ki) - p%Gamma = 0.5_R8Ki - p%AlphaM + p%AlphaF - p%Beta = (1.0_R8Ki - p%AlphaM + p%AlphaF)**2/4.0_R8Ki - - p%C(1) = (1.0_R8Ki - p%AlphaF)/(1.0_R8Ki - p%AlphaM) - p%C(2) = p%DT*p%Gamma*p%C(1) - p%C(3) = p%DT**2*p%Beta*p%C(1) - - !---------------------------------------------------------------------------- - ! Debug - !---------------------------------------------------------------------------- - - if (DebugSolver) then - call GetNewUnit(DebugUn, ErrStat2, ErrMsg2); if (Failed()) return - call OpenFOutFile(DebugUn, "solver.dbg", ErrStat2, ErrMsg2); if (Failed()) return - call Solver_Init_Debug(p, m, Mods) - end if - contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -439,13 +492,13 @@ logical function Failed() end function end subroutine -subroutine Solver_DefineMappings(Mappings, Mods, ErrStat, ErrMsg) +subroutine DefineMappings(Mappings, Mods, ErrStat, ErrMsg) type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) - type(ModDataType), intent(inout) :: Mods(:) !< Module data + type(ModDataType), intent(inout) :: Mods(:) !< Module data integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'Solver_DefineMappings' + character(*), parameter :: RoutineName = 'DefineMappings' integer(IntKi) :: ErrStat2 ! local error status character(ErrMsgLen) :: ErrMsg2 ! local error message integer(IntKi) :: iMap, iModOut, iModIn, i, j @@ -596,7 +649,7 @@ subroutine AddMotionMapping(Key, SrcModID, SrcIns, SrcMeshName, & end subroutine end subroutine -subroutine Solver_TransferXtoQ(ixqd, x, q) +subroutine TransferXtoQ(ixqd, x, q) integer(IntKi), intent(in) :: ixqd(:, :) real(R8Ki), intent(in) :: x(:) real(R8Ki), intent(inout) :: q(:, :) @@ -606,7 +659,7 @@ subroutine Solver_TransferXtoQ(ixqd, x, q) end do end subroutine -subroutine Solver_TransferQtoX(ixqd, q, x) +subroutine TransferQtoX(ixqd, q, x) integer(IntKi), intent(in) :: ixqd(:, :) real(R8Ki), intent(in) :: q(:, :) real(R8Ki), intent(inout) :: x(:) @@ -629,7 +682,7 @@ pure function NeedWriteOutput(n_t_global, t_global, t_initial, n_DT_Out) result( else WriteNeeded = .false. end if -end function NeedWriteOutput +end function subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: p !< Parameters @@ -683,7 +736,7 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) call PackModuleStates(ModData(p%iModTC), STATE_CURR, Turbine, x=m%x) ! Transfer initial state to state q matrix - call Solver_TransferXtoQ(p%ixqd, m%x, m%qn) + call TransferXtoQ(p%ixqd, m%x, m%qn) ! Allocate acceleration array which will be used to check for convergence ! of initial acceleration. Transfer initial accelerations from q matrix @@ -831,27 +884,27 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Calculate displacements for the next step m%q(:, COL_D) = m%qn(:, COL_D) + & p%DT*m%qn(:, COL_V) + & - p%DT**2*(0.5_R8Ki - p%Beta)*m%qn(:, COL_AA) + & - p%DT**2*p%Beta*m%q(:, COL_AA) + p%C(4)*m%qn(:, COL_AA) + & + p%C(5)*m%q(:, COL_AA) ! Calculate velocities for the next step m%q(:, COL_V) = m%qn(:, COL_V) + & - p%DT*(1.0_R8Ki - p%Gamma)*m%qn(:, COL_AA) + & - p%DT*p%Gamma*m%q(:, COL_AA) + p%C(6)*m%qn(:, COL_AA) + & + p%C(7)*m%q(:, COL_AA) ! Calculate difference between new and old states m%dq = m%q - m%qn ! Transfer delta state matrix to delta x array m%dx = 0.0_R8Ki - call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) + call TransferQtoX(p%ixqd, m%dq, m%dx) ! Add delta to x array to get new states (respect variable fields) ! required for orientation fields in states call AddDeltaToStates(Mods, p%iModTC, m%dx, m%x) ! Update state matrix with updated state values - call Solver_TransferXtoQ(p%ixqd, m%x, m%q) + call TransferXtoQ(p%ixqd, m%x, m%q) ! Initialize delta arrays for iterations m%dq = 0.0_R8Ki @@ -905,7 +958,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Populate state matrix with latest values from state array in case it ! changed during FAST_UpdateStates calls - call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + call TransferXtoQ(p%ixqd, m%xn, m%qn) ! Pack Option 1 inputs into u array call PackModuleInputs(Mods, p%iModOpt1, Turbine, u=m%un) @@ -1014,13 +1067,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer change in q state matrix to change in x array m%dx = 0.0_R8Ki - call Solver_TransferQtoX(p%ixqd, m%dq, m%dx) + call TransferQtoX(p%ixqd, m%dq, m%dx) ! Add delta to x array to get new states (respect variable fields) call AddDeltaToStates(Mods, p%iModTC, m%dx, m%xn) ! Overwrites state matrix values that were changed in AddDeltaToStates - call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + call TransferXtoQ(p%ixqd, m%xn, m%qn) ! Transfer updated state to TC modules call UnpackModuleStates(Mods, p%iModTC, STATE_PRED, Turbine, x=m%xn) @@ -1096,7 +1149,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do ! Update state matrix from state array - call Solver_TransferXtoQ(p%ixqd, m%xn, m%qn) + call TransferXtoQ(p%ixqd, m%xn, m%qn) ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(p%iModAll) From fecfcbd796a3859a57fcfb9cdc43a5c6ec685bcb Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:42:29 +0000 Subject: [PATCH 39/61] Add code to add modules in FAST_Subs --- modules/openfast-library/src/FAST_Subs_TC.f90 | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index b706f0cb30..a7a5a9ec6e 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -286,7 +286,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if ! Add module to array of modules - call MV_AddModule(m_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & + CALL MV_AddModule(m_FAST%Modules, Module_ED, 'ED', 1, p_FAST%dt_module(Module_ED), p_FAST%DT, & Init%OutData_ED%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -411,7 +411,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if ! Add module instance to array of modules - call MV_AddModule(m_FAST%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) + CALL MV_AddModule(m_FAST%Modules, Module_BD, 'BD', k, p_FAST%dt_module(Module_BD), p_FAST%DT, Init%OutData_BD(k)%Vars, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END DO @@ -527,6 +527,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MV_AddModule(m_FAST%Modules, Module_AD, 'AD', 1, p_FAST%dt_module(Module_AD), p_FAST%DT, & + Init%OutData_AD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) @@ -627,6 +631,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MV_AddModule(m_FAST%Modules, Module_IfW, 'IfW', 1, p_FAST%dt_module(Module_IfW), p_FAST%DT, & + Init%OutData_IfW%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Set pointers to flowfield IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => IfW%p%FlowField @@ -1410,6 +1418,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL MV_AddModule(m_FAST%Modules, Module_SrvD, 'SrvD', 1, p_FAST%dt_module(Module_SrvD), p_FAST%DT, & + Init%OutData_SrvD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) From 61eb515bfc2d62360244aa1e20fe4bd93b1945d7 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 17:42:50 +0000 Subject: [PATCH 40/61] Fix poorly formatted line in ElastoDyn Registry --- modules/elastodyn/src/ElastoDyn_Registry.txt | 2 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index f56bb2c209..03f99e89a5 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -522,7 +522,7 @@ typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAP typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - -typedef ^ MiscVarType ModValsType Vals - - "Values corresponding to module variables" +typedef ^ MiscVarType ModValsType Vals - - - "Values corresponding to module variables" # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 93e9325fac..d74095cdd6 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -531,7 +531,7 @@ MODULE ElastoDyn_Types 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 = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] - TYPE(ModValsType) :: Vals + TYPE(ModValsType) :: Vals !< Values corresponding to module variables [-] END TYPE ED_MiscVarType ! ======================= ! ========= ED_ParameterType ======= From e39fcd2b9571d8f026a5d33bb459dc925815bdda Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 7 Sep 2023 20:03:26 +0000 Subject: [PATCH 41/61] Add ModVars to AeroDyn and ServoDyn registries --- modules/aerodyn/src/AeroDyn_Registry.txt | 3 + modules/aerodyn/src/AeroDyn_Types.f90 | 87 +++++++++++++++++++++ modules/servodyn/src/ServoDyn_Registry.txt | 3 + modules/servodyn/src/ServoDyn_Types.f90 | 90 ++++++++++++++++++++++ 4 files changed, 183 insertions(+) diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 8bc7cd1d81..c153c816c0 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -138,6 +138,7 @@ typedef ^ RotInitOutputType ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ InitOutputType RotInitOutputType rotors {:} - - "Rotor init output type" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - # ..... Input file data ........................................................................................................... # ..... Primary Input file data ................................................................................................... @@ -324,6 +325,7 @@ typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - +typedef ^ MiscVarType ModValsType Vals - - - "Module Values" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -410,6 +412,7 @@ typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - # ..... Inputs .................................................................................................................... diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 3a13bbff99..465e1436e9 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -166,6 +166,7 @@ MODULE AeroDyn_Types TYPE, PUBLIC :: AD_InitOutputType TYPE(RotInitOutputType) , DIMENSION(:), ALLOCATABLE :: rotors !< Rotor init output type [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE AD_InitOutputType ! ======================= ! ========= RotInputFile ======= @@ -366,6 +367,7 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] + TYPE(ModValsType) :: Vals !< Module Values [-] END TYPE AD_MiscVarType ! ======================= ! ========= RotParameterType ======= @@ -447,6 +449,7 @@ MODULE AeroDyn_Types LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE AD_ParameterType ! ======================= ! ========= RotInputType ======= @@ -2154,6 +2157,7 @@ subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -2178,6 +2182,7 @@ subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) end subroutine subroutine AD_PackInitOutput(Buf, Indata) @@ -2186,6 +2191,7 @@ subroutine AD_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackInitOutput' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then @@ -2197,6 +2203,13 @@ subroutine AD_PackInitOutput(Buf, Indata) end do end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2208,6 +2221,8 @@ subroutine AD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) @@ -2225,6 +2240,26 @@ subroutine AD_UnPackInitOutput(Buf, OutData) end do end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -5128,6 +5163,9 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%WindAcc = SrcMiscData%WindAcc end if + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -5172,6 +5210,8 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%WindAcc)) then deallocate(MiscData%WindAcc) end if + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackMisc(Buf, Indata) @@ -5216,6 +5256,7 @@ subroutine AD_PackMisc(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) call RegPack(Buf, InData%WindAcc) end if + call NWTC_Library_PackModValsType(Buf, InData%Vals) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5302,6 +5343,7 @@ subroutine AD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WindAcc) if (RegCheckErr(Buf, RoutineName)) return end if + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals end subroutine subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -6329,6 +6371,18 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps DstParamData%UA_Flag = SrcParamData%UA_Flag DstParamData%FlowField => SrcParamData%FlowField + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if end subroutine subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -6363,6 +6417,12 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%FlowField) + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if end subroutine subroutine AD_PackParam(Buf, Indata) @@ -6405,6 +6465,13 @@ subroutine AD_PackParam(Buf, Indata) call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) end if end if + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6482,6 +6549,26 @@ subroutine AD_UnPackParam(Buf, OutData) else OutData%FlowField => null() end if + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if end subroutine subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 4f3ab877c7..6fa70f2e33 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -71,6 +71,7 @@ typedef ^ InitInputType ReKi URefLid - - - "Reference average wind spee typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - typedef ^ InitOutputType IntKi CouplingScheme - - - "Switch that indicates if a particular coupling scheme is required" - typedef ^ InitOutputType Logical UseHSSBrake - - - "flag to determine if high-speed shaft brake is potentially used (true=yes)" - # Linearization @@ -360,6 +361,7 @@ typedef ^ MiscVarType StC_OutputType y_TStC {:} - - "StC module outputs - tower" typedef ^ MiscVarType StC_OutputType y_SStC {:} - - "StC module outputs - substructure" - typedef ^ MiscVarType SrvD_ModuleMapType SrvD_MeshMap - - - "Mesh mapping from inputs/output meshes to StC input/output meshes" - typedef ^ MiscVarType IntKi PrevTstepNcall - -1 - "Previous timestep N for tracking when in predictor/corrector loop for setting StC u values" - +typedef ^ MiscVarType ModValsType Vals - - - "Module Values" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -457,6 +459,7 @@ typedef ^ ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed typedef ^ ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" typedef ^ ParameterType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" # parameters for other modules: +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - typedef ^ ParameterType StC_ParameterType BStC {:} - - "StC module parameters - blade" - typedef ^ ParameterType StC_ParameterType NStC {:} - - "StC module parameters - nacelle" - typedef ^ ParameterType StC_ParameterType TStC {:} - - "StC module parameters - tower" - diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 59e61da949..f6cec2a5e1 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -90,6 +90,7 @@ 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 [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -372,6 +373,7 @@ MODULE ServoDyn_Types TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: y_SStC !< StC module outputs - substructure [-] TYPE(SrvD_ModuleMapType) :: SrvD_MeshMap !< Mesh mapping from inputs/output meshes to StC input/output meshes [-] INTEGER(IntKi) :: PrevTstepNcall = -1 !< Previous timestep N for tracking when in predictor/corrector loop for setting StC u values [-] + TYPE(ModValsType) :: Vals !< Module Values [-] END TYPE SrvD_MiscVarType ! ======================= ! ========= SrvD_ParameterType ======= @@ -465,6 +467,7 @@ MODULE ServoDyn_Types 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(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -1211,6 +1214,7 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake if (allocated(SrcInitOutputData%LinNames_y)) then @@ -1328,6 +1332,7 @@ subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1358,6 +1363,7 @@ subroutine SrvD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then @@ -1370,6 +1376,13 @@ subroutine SrvD_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, InData%CouplingScheme) call RegPack(Buf, InData%UseHSSBrake) call RegPack(Buf, allocated(InData%LinNames_y)) @@ -1422,6 +1435,8 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) @@ -1452,6 +1467,26 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(Buf, OutData%CouplingScheme) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%UseHSSBrake) @@ -5274,6 +5309,9 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -5410,6 +5448,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) end if call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SrvD_PackMisc(Buf, Indata) @@ -5546,6 +5586,7 @@ subroutine SrvD_PackMisc(Buf, Indata) end if call SrvD_PackModuleMapType(Buf, InData%SrvD_MeshMap) call RegPack(Buf, InData%PrevTstepNcall) + call NWTC_Library_PackModValsType(Buf, InData%Vals) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5770,6 +5811,7 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call SrvD_UnpackModuleMapType(Buf, OutData%SrvD_MeshMap) ! SrvD_MeshMap call RegUnpack(Buf, OutData%PrevTstepNcall) if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals end subroutine subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -5944,6 +5986,18 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TrimCase = SrcParamData%TrimCase DstParamData%TrimGain = SrcParamData%TrimGain DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if if (allocated(SrcParamData%BStC)) then LB(1:1) = lbound(SrcParamData%BStC) UB(1:1) = ubound(SrcParamData%BStC) @@ -6264,6 +6318,12 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) end if call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%BStC)) then LB(1:1) = lbound(ParamData%BStC) UB(1:1) = ubound(ParamData%BStC) @@ -6359,6 +6419,7 @@ subroutine SrvD_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'SrvD_PackParam' integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%HSSBrDT) @@ -6477,6 +6538,13 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%TrimCase) call RegPack(Buf, InData%TrimGain) call RegPack(Buf, InData%RotSpeedRef) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -6622,6 +6690,8 @@ subroutine SrvD_UnPackParam(Buf, OutData) integer(IntKi) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return @@ -6873,6 +6943,26 @@ subroutine SrvD_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RotSpeedRef) if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 18c2f792d5cc97b74e0f81691d2687fe36f0ca70 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 8 Sep 2023 12:24:21 +0000 Subject: [PATCH 42/61] Mapping init in FAST_Eval, simplify InputSolve --- modules/openfast-library/src/FAST_Eval.f90 | 276 +++++++++++++----- .../openfast-library/src/FAST_Registry.txt | 2 +- modules/openfast-library/src/FAST_Subs_TC.f90 | 11 +- modules/openfast-library/src/FAST_Types.f90 | 8 +- modules/openfast-library/src/Solver.f90 | 235 +++------------ 5 files changed, 246 insertions(+), 286 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 520c37c804..1e28f6f1d9 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -308,7 +308,6 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) - case (Module_ED) ! Transfer tight coupling states to module @@ -380,21 +379,165 @@ logical function Failed() end function end subroutine -subroutine FAST_InitMappings(Maps, T, ErrStat, ErrMsg) - type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg +subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) + type(TC_MappingType), allocatable, intent(inout) :: Maps(:) + type(ModDataType), intent(inout) :: Mods(:) !< Module data + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = 'FAST_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i - integer(IntKi) :: DstIns, SrcIns + character(*), parameter :: RoutineName = 'FAST_InitMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + integer(IntKi) :: DstIns, SrcIns + integer(IntKi) :: iMap, ModIns, iModIn + logical, allocatable :: isActive(:) ErrStat = ErrID_None ErrMsg = '' + !---------------------------------------------------------------------------- + ! Define mesh mappings between modules + !---------------------------------------------------------------------------- + + ! Define a list of all possible module mesh mappings between modules + ! Note: the mesh names must map those defined in MV_AddMeshVar in the modules + allocate (Maps(0), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Loop through modules + do iMap = 1, size(Mods) + + ! Module instance + ModIns = Mods(iMap)%Ins + + ! Switch based on module ID + select case (Mods(iMap)%ID) + + case (Module_AD) + + call AddMotionMapping(Key='ED HubPtMotion -> AD HubMotion', & + SrcModID=Module_ED, SrcIns=1, SrcMeshName='Hub', & + DstModID=Module_AD, DstIns=1, DstMeshName='HubMotion', & + Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) + + call AddMotionMapping(Key='ED HubPtMotion -> AD HubMotion', & + SrcModID=Module_ED, SrcIns=1, SrcMeshName='Hub', & + DstModID=Module_AD, DstIns=1, DstMeshName='HubMotion') + + case (Module_BD) + + call AddMotionMapping(Key='ED BladeRoot -> BD RootMotion', & + SrcModID=Module_ED, SrcIns=1, SrcMeshName='Blade root '//trim(Num2LStr(ModIns)), & + DstModID=Module_BD, DstIns=ModIns, DstMeshName='RootMotion') + + call AddLoadMapping(Key='BD ReactionForce -> ED HubLoad', & + SrcModID=Module_BD, SrcIns=ModIns, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & + DstModID=Module_ED, DstIns=1, DstMeshName='Hub', DstDispMeshName='Hub') + + end select + end do + + !---------------------------------------------------------------------------- + ! Get module indices in ModData and determine which mappings are active + !---------------------------------------------------------------------------- + + ! Allocate array to indicate if mapping is active and initialize to false + call AllocAry(isActive, size(Maps), "isActive", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + isActive = .false. + + ! Loop through Maps + do iMap = 1, size(Maps) + + ! Loop modules, if module ID matches source module ID + ! and module instance matches source module instance, exit loop + do ModIns = 1, size(Mods) + if ((Maps(iMap)%SrcModID == Mods(ModIns)%ID) .and. & + (Maps(iMap)%SrcIns == Mods(ModIns)%Ins)) exit + end do + + ! Loop through modules, if module ID matches destination module ID + ! and module instance matches destinatino module instance, exit loop + do iModIn = 1, size(Mods) + if ((Maps(iMap)%DstModID == Mods(iModIn)%ID) .and. & + (Maps(iMap)%DstIns == Mods(iModIn)%Ins)) exit + end do + + ! If input or output module not found, mapping is not active, cycle + if (ModIns > size(Mods) .or. iModIn > size(Mods)) cycle + + ! Mark mapping as active + isActive(iMap) = .true. + + ! Module input/ouput IDs and instances found, populate mapping + Maps(iMap)%SrcModIdx = ModIns + Maps(iMap)%DstModIdx = iModIn + + associate (Map => Maps(iMap), & + SrcMod => Mods(Maps(iMap)%SrcModIdx), & + DstMod => Mods(Maps(iMap)%DstModIdx)) + + ! TODO: Add logic to check if mesh exists, skip mapping if it doesn't exist + + ! If load mapping + if (Map%IsLoad) then + + ! Source mesh variable indices + Map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, Map%SrcMeshName, LoadFields(ModIns)), ModIns=1, size(LoadFields))] + Map%SrcVarIdx = pack(Map%SrcVarIdx, Map%SrcVarIdx > 0) + + ! Destination mesh variable indices + Map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, Map%DstMeshName, LoadFields(ModIns)), ModIns=1, size(LoadFields))] + Map%DstVarIdx = pack(Map%DstVarIdx, Map%DstVarIdx > 0) + + ! Source displacement mesh is in input of source module (only translation displacement needed) + Map%SrcDispVarIdx = MV_VarIndex(SrcMod%Vars%u, Map%SrcDispMeshName, VF_TransDisp) + + ! Destination displacement mesh is in output of destination module (only translation displacement needed) + Map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, Map%DstDispMeshName, VF_TransDisp) + + ! Mark displacement variables with Solve flag + call SetFlags(SrcMod%Vars%u(Map%SrcDispVarIdx), VF_Solve) + call SetFlags(DstMod%Vars%y(Map%DstDispVarIdx), VF_Solve) + + else + + ! Source mesh motion field variables + map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(ModIns)), ModIns=1, size(MotionFields))] + map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) + + ! Destination mesh motion field variables + map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(ModIns)), ModIns=1, size(MotionFields))] + map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) + + end if + + ! Mark variables with Solve flag + do ModIns = 1, size(map%SrcVarIdx) + call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(ModIns)), VF_Solve) + end do + do ModIns = 1, size(map%DstVarIdx) + call SetFlags(DstMod%Vars%u(map%DstVarIdx(ModIns)), VF_Solve) + end do + + end associate + + end do + + ! Remove inactive mappings + Maps = pack(Maps, mask=isActive) + + !---------------------------------------------------------------------------- + ! Initialize Mapping meshes + !---------------------------------------------------------------------------- + ! Loop through mappings do i = 1, size(Maps) @@ -424,14 +567,44 @@ subroutine FAST_InitMappings(Maps, T, ErrStat, ErrMsg) end do contains + subroutine AddLoadMapping(Key, SrcModID, SrcIns, SrcMeshName, SrcDispMeshName, & + DstModID, DstIns, DstMeshName, DstDispMeshName, Active) + character(*), intent(in) :: Key + integer(IntKi), intent(in) :: SrcModID, DstModID + integer(IntKi), intent(in) :: SrcIns, DstIns + character(*), intent(in) :: SrcMeshName, DstMeshName + character(*), intent(in) :: SrcDispMeshName, DstDispMeshName + logical, optional, intent(in) :: Active + if (present(Active)) then + if (.not. Active) return + end if + Maps = [Maps, TC_MappingType(Key=Key, isLoad=.true., & + SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & + DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] + end subroutine + subroutine AddMotionMapping(Key, SrcModID, SrcIns, SrcMeshName, & + DstModID, DstIns, DstMeshName, Active) + character(*), intent(in) :: Key + integer(IntKi), intent(in) :: SrcModID, DstModID + integer(IntKi), intent(in) :: SrcIns, DstIns + character(*), intent(in) :: SrcMeshName, DstMeshName + logical, optional, intent(in) :: Active + if (present(Active)) then + if (.not. Active) return + end if + Maps = [Maps, TC_MappingType(Key=Key, isLoad=.false., & + SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, & + DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName)] + end subroutine logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function end subroutine -subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) +subroutine FAST_CalcOutput(Mod, Maps, this_time, this_state, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: Mod !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) !< Output->Input mappings real(DbKi), intent(in) :: this_time !< Time integer(IntKi), intent(in) :: this_state !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -441,8 +614,7 @@ subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_CalcOutput' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j - integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' @@ -492,6 +664,11 @@ subroutine FAST_CalcOutput(Mod, this_time, this_state, T, ErrStat, ErrMsg) return end select + ! Set updated flag in mappings where this module is the source + do i = 1, size(Maps) + if (Maps(i)%SrcModIdx == Mod%Idx) Maps(i)%Ready = .true. + end do + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -939,62 +1116,6 @@ logical function Failed() end function end subroutine -subroutine FAST_MapOutputs(Mod, Maps, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'FAST_TransferOutputs' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i - integer(IntKi) :: DstIns, SrcIns - - ! Loop through mappings that use this module's outputs - do i = 1, size(Maps) - - ! If map doesn't apply to this module, cycle - if (Mod%Idx /= Maps(i)%SrcModIdx) cycle - - ! Get source and destination module instances - SrcIns = Maps(i)%SrcIns - DstIns = Maps(i)%DstIns - - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Maps(i)%Key) - - case ('ED BladeRoot -> BD RootMotion') - - call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(DstIns), Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! - - case ('BD ReactionForce -> ED HubLoad') - - ! u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations - call Transfer_Point_to_Point(T%BD%y(SrcIns)%ReactionForce, Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & - T%BD%Input(1, SrcIns)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return - ! u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force - ! u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment - - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) - return - end select - - ! Set flag indicating that mapping has been updated - Maps(i)%Updated = .true. - - end do - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) type(ModDataType), intent(in) :: Mod !< Module data type(TC_MappingType), intent(inout) :: Maps(:) @@ -1069,12 +1190,12 @@ subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) ! Loop through mappings that set this module's inputs do i = 1, size(Maps) - ! If mapping hasn't been updated, cycle - if (.not. Maps(i)%Updated) cycle - - ! If map doesn't apply to this module, cycle + ! If this is not the destination module, cycle if (Mod%Idx /= Maps(i)%DstModIdx) cycle + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + ! Get source and destination module instances SrcIns = Maps(i)%SrcIns DstIns = Maps(i)%DstIns @@ -1084,7 +1205,8 @@ subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) case ('ED BladeRoot -> BD RootMotion') - call MeshCopy(Maps(i)%MeshTmp, u_BD%RootMotion, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(DstIns), u_BD%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('BD ReactionForce -> ED HubLoad') @@ -1094,6 +1216,10 @@ subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) ED_ResetHubPtLoad = .false. end if + call Transfer_Point_to_Point(T%BD%y(SrcIns)%ReactionForce, Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, SrcIns)%RootMotion, T%ED%y%HubPtMotion) + if (Failed()) return + u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index f0a5234ebd..f45fa17254 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -109,7 +109,7 @@ typedef ^ ^ IntKi DstDispVarIdx - - - typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from output variable to input variable" - typedef ^ ^ logical IsLoad - - - "Flag indicating if this is a load or motion mapping" - -typedef ^ ^ logical Updated - - - "Flag indicating if this mesh has been updated" - +typedef ^ ^ logical Ready - - - "Flag indicating output has been ready to be transferred" - # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index a7a5a9ec6e..e8fdc4861a 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -51,18 +51,18 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine, ErrStat, ErrMsg, InFile ) END IF ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine, ErrStat, ErrMsg ) END IF @@ -70,7 +70,7 @@ END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to call Init routine for each module. This routine sets all of the init input data for each module. SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 USE Solver, only: Solver_Init @@ -105,6 +105,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CHARACTER(*), OPTIONAL, INTENT(IN ) :: InFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine TYPE(FAST_ExternInitType), OPTIONAL, INTENT(IN) :: ExternInitData !< Initialization input data from an external source (Simulink) @@ -1479,7 +1480,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize tight coupling solver ! ------------------------------------------------------------------------- - CALL Solver_Init(p_FAST%Solver, m_FAST%Solver, m_FAST%Modules, ErrStat2, ErrMsg2) + CALL Solver_Init(p_FAST%Solver, m_FAST%Solver, m_FAST%Modules, Turbine, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 386e43266d..c1f5ae8122 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -129,7 +129,7 @@ MODULE FAST_Types TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from output variable to input variable [-] LOGICAL :: IsLoad = .false. !< Flag indicating if this is a load or motion mapping [-] - LOGICAL :: Updated = .false. !< Flag indicating if this mesh has been updated [-] + LOGICAL :: Ready = .false. !< Flag indicating output has been ready to be transferred [-] END TYPE TC_MappingType ! ======================= ! ========= TC_ParameterType ======= @@ -1561,7 +1561,7 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstTC_MappingTypeData%IsLoad = SrcTC_MappingTypeData%IsLoad - DstTC_MappingTypeData%Updated = SrcTC_MappingTypeData%Updated + DstTC_MappingTypeData%Ready = SrcTC_MappingTypeData%Ready end subroutine subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) @@ -1616,7 +1616,7 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) call MeshPack(Buf, InData%MeshTmp) call NWTC_Library_PackMeshMapType(Buf, InData%MeshMap) call RegPack(Buf, InData%IsLoad) - call RegPack(Buf, InData%Updated) + call RegPack(Buf, InData%Ready) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1686,7 +1686,7 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%MeshMap) ! MeshMap call RegUnpack(Buf, OutData%IsLoad) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Updated) + call RegUnpack(Buf, OutData%Ready) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index b24495bb09..5507e88807 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -1,9 +1,9 @@ module Solver +use NWTC_LAPACK use FAST_Solver use FAST_ModTypes use FAST_Eval -use NWTC_LAPACK use ElastoDyn use BeamDyn use SubDyn @@ -26,7 +26,7 @@ module Solver integer(IntKi), parameter :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] ! Debugging -logical, parameter :: DebugSolver = .false. +logical, parameter :: DebugSolver = .true. integer(IntKi) :: DebugUn = -1 character(*), parameter :: DebugFile = 'solver.dbg' logical, parameter :: DebugJacobian = .false. @@ -34,18 +34,19 @@ module Solver contains -subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) +subroutine Solver_Init(p, m, Mods, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(inout) :: p !< Parameters type(TC_MiscVarType), intent(out) :: m !< Misc variables for optimization (not copied in glue code) type(ModDataType), intent(inout) :: Mods(:) !< Module data + type(FAST_TurbineType), intent(inout) :: Turbine !< all data for one instance of a turbine integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None character(*), parameter :: RoutineName = 'Solver_Init' integer(IntKi) :: ErrStat2 ! local error status character(ErrMsgLen) :: ErrMsg2 ! local error message - integer(IntKi) :: i, j, k, n + integer(IntKi) :: i, j, k integer(IntKi) :: NumX, NumQ, NumU, NumY, NumJ integer(IntKi), allocatable :: modIDs(:), modInds(:) type(TC_MappingType) :: MeshMap @@ -62,11 +63,11 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Indicies of all modules p%iModAll = [pack(modInds, ModIDs == Module_SrvD), & - pack(modInds, ModIDs == Module_IfW), & - pack(modInds, ModIDs == Module_AD), & pack(modInds, ModIDs == Module_ED), & pack(modInds, ModIDs == Module_BD), & - pack(modInds, ModIDs == Module_SD)] + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_AD)] ! Indicies of tight coupling modules p%iModTC = [pack(modInds, ModIDs == Module_ED), & @@ -107,7 +108,7 @@ subroutine Solver_Init(p, m, Mods, ErrStat, ErrMsg) ! Initialize mesh mappings (must be done before calculating global indices) !---------------------------------------------------------------------------- - call DefineMappings(m%Mappings, Mods, ErrStat2, ErrMsg2) + call FAST_InitMappings(m%Mappings, Mods, Turbine, ErrStat2, ErrMsg2) if (Failed()) return !---------------------------------------------------------------------------- @@ -219,7 +220,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, integer(IntKi) :: ErrStat2 ! local error status character(ErrMsgLen) :: ErrMsg2 ! local error message integer(IntKi), allocatable :: modIDs(:), vec1(:), vec2(:), iuLoad(:) - integer(IntKi) :: i, j, k, n + integer(IntKi) :: i, j, k, num ErrStat = ErrID_None ErrMsg = '' @@ -411,7 +412,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! Initialize number of q states (ignore derivatives) NumQ = 0 - n = 0 + num = 0 ! Loop through modules do i = 1, size(Mods) @@ -458,15 +459,15 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! ixqd is 3xN where each row is [global x array index, q matrix row, q matrix col] do j = 1, size(Mods(i)%Vars%x) do k = 1, Mods(i)%Vars%x(j)%Num - n = n + 1 - p%ixqd(:, n) = [Mods(i)%Vars%x(j)%iGblSol(k), Mods(i)%Vars%x(j)%iq(k), Mods(i)%Vars%x(j)%DerivOrder + 1] + num = num + 1 + p%ixqd(:, num) = [Mods(i)%Vars%x(j)%iGblSol(k), Mods(i)%Vars%x(j)%iq(k), Mods(i)%Vars%x(j)%DerivOrder + 1] end do end do end do ! Remove unused x->q indicies - p%ixqd = p%ixqd(:, 1:n) + p%ixqd = p%ixqd(:, 1:num) !---------------------------------------------------------------------------- ! Jacobian indices and ranges @@ -492,163 +493,6 @@ logical function Failed() end function end subroutine -subroutine DefineMappings(Mappings, Mods, ErrStat, ErrMsg) - type(TC_MappingType), allocatable, intent(inout) :: Mappings(:) - type(ModDataType), intent(inout) :: Mods(:) !< Module data - integer(IntKi), intent(out) :: ErrStat !< Error status of the operation - character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - character(*), parameter :: RoutineName = 'DefineMappings' - integer(IntKi) :: ErrStat2 ! local error status - character(ErrMsgLen) :: ErrMsg2 ! local error message - integer(IntKi) :: iMap, iModOut, iModIn, i, j - logical, allocatable :: isActive(:) - - ErrStat = ErrID_None - ErrMsg = '' - - !---------------------------------------------------------------------------- - ! Define mesh mappings between modules - !---------------------------------------------------------------------------- - - ! Define a list of all possible module mesh mappings between modules - ! Note: the mesh names must map those defined in MV_AddMeshVar in the modules - allocate (Mappings(0), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating mappings", ErrStat, ErrMsg, RoutineName) - return - end if - - do iMap = 1, size(Mods) - if (Mods(iMap)%ID == Module_BD) then - iModOut = Mods(iMap)%Ins - call AddMotionMapping(Key='ED BladeRoot -> BD RootMotion', & - SrcModID=Module_ED, SrcIns=1, SrcMeshName='Blade root '//trim(Num2LStr(iModOut)), & - DstModID=Module_BD, DstIns=iModOut, DstMeshName='RootMotion') - call AddLoadMapping(Key='BD ReactionForce -> ED HubLoad', & - SrcModID=Module_BD, SrcIns=iModOut, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & - DstModID=Module_ED, DstIns=1, DstMeshName='Hub', DstDispMeshName='Hub') - end if - end do - - !---------------------------------------------------------------------------- - ! Get module indices in ModData and determine which mappings are active - !---------------------------------------------------------------------------- - - ! Allocate array to indicate if mapping is active and initialize to false - call AllocAry(isActive, size(Mappings), "isActive", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - isActive = .false. - - ! Loop through mappings - do iMap = 1, size(Mappings) - - ! Loop modules, if module ID matches source module ID - ! and module instance matches source module instance, exit loop - do iModOut = 1, size(Mods) - if ((Mappings(iMap)%SrcModID == Mods(iModOut)%ID) .and. & - (Mappings(iMap)%SrcIns == Mods(iModOut)%Ins)) exit - end do - - ! Loop through modules, if module ID matches destination module ID - ! and module instance matches destinatino module instance, exit loop - do iModIn = 1, size(Mods) - if ((Mappings(iMap)%DstModID == Mods(iModIn)%ID) .and. & - (Mappings(iMap)%DstIns == Mods(iModIn)%Ins)) exit - end do - - ! If input or output module not found, mapping is not active, cycle - if (iModOut > size(Mods) .or. iModIn > size(Mods)) cycle - - ! Mark mapping as active - isActive(iMap) = .true. - - ! Module input/ouput IDs and instances found, populate mapping - Mappings(iMap)%SrcModIdx = iModOut - Mappings(iMap)%DstModIdx = iModIn - - associate (map => Mappings(iMap), & - SrcMod => Mods(Mappings(iMap)%SrcModIdx), & - DstMod => Mods(Mappings(iMap)%DstModIdx)) - - ! TODO: Add logic to check if mesh exists, skip mapping if it doesn't exist - - ! If load mapping - if (map%IsLoad) then - - ! Source mesh variable indices - map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, LoadFields(iModOut)), iModOut=1, size(LoadFields))] - map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) - - ! Destination mesh variable indices - map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, LoadFields(iModOut)), iModOut=1, size(LoadFields))] - map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) - - ! Source displacement mesh is in input of source module (only translation displacement needed) - map%SrcDispVarIdx = MV_VarIndex(SrcMod%Vars%u, map%SrcDispMeshName, VF_TransDisp) - - ! Destination displacement mesh is in output of destination module (only translation displacement needed) - map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, map%DstDispMeshName, VF_TransDisp) - - ! Mark displacement variables with Solve flag - call SetFlags(SrcMod%Vars%u(map%SrcDispVarIdx), VF_Solve) - call SetFlags(DstMod%Vars%y(map%DstDispVarIdx), VF_Solve) - - else - - ! Source mesh motion field variables - map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(iModOut)), iModOut=1, size(MotionFields))] - map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) - - ! Destination mesh motion field variables - map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(iModOut)), iModOut=1, size(MotionFields))] - map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) - - end if - - ! Mark variables with Solve flag - do iModOut = 1, size(map%SrcVarIdx) - call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(iModOut)), VF_Solve) - end do - do iModOut = 1, size(map%DstVarIdx) - call SetFlags(DstMod%Vars%u(map%DstVarIdx(iModOut)), VF_Solve) - end do - - end associate - - end do - - ! Remove inactive mappings - Mappings = pack(Mappings, mask=isActive) - -contains - subroutine AddLoadMapping(Key, SrcModID, SrcIns, SrcMeshName, SrcDispMeshName, & - DstModID, DstIns, DstMeshName, DstDispMeshName) - character(*), intent(in) :: Key - integer(IntKi), intent(in) :: SrcModID, DstModID - integer(IntKi), intent(in) :: SrcIns, DstIns - character(*), intent(in) :: SrcMeshName, DstMeshName - character(*), intent(in) :: SrcDispMeshName, DstDispMeshName - if (.not. allocated(Mappings)) allocate (Mappings(0)) - Mappings = [Mappings, TC_MappingType(Key=Key, isLoad=.true., & - SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & - DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] - end subroutine - subroutine AddMotionMapping(Key, SrcModID, SrcIns, SrcMeshName, & - DstModID, DstIns, DstMeshName) - character(*), intent(in) :: Key - integer(IntKi), intent(in) :: SrcModID, DstModID - integer(IntKi), intent(in) :: SrcIns, DstIns - character(*), intent(in) :: SrcMeshName, DstMeshName - if (.not. allocated(Mappings)) allocate (Mappings(0)) - Mappings = [Mappings, TC_MappingType(Key=Key, isLoad=.false., & - SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, & - DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName)] - end subroutine -end subroutine - subroutine TransferXtoQ(ixqd, x, q) integer(IntKi), intent(in) :: ixqd(:, :) real(R8Ki), intent(in) :: x(:) @@ -708,14 +552,7 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ErrMsg = '' !---------------------------------------------------------------------------- - ! Initialize module mappings - ! TODO: Move this into init - !---------------------------------------------------------------------------- - - call FAST_InitMappings(m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - - !---------------------------------------------------------------------------- - ! Miscellaneous initial step + ! Miscellaneous initial step setup !---------------------------------------------------------------------------- t_initial = Turbine%m_FAST%t_global @@ -743,8 +580,8 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) call AllocAry(accel, size(m%qn, dim=2), "accel", ErrStat2, ErrMsg2); if (Failed()) return accel = m%qn(:, COL_A) - ! Reset mappings updated flags - m%Mappings%Updated = .false. + ! Reset mapping ready for transfer flag + m%Mappings%Ready = .false. ! Loop until initial accelerations are converged, or max iterations are reached. ! TODO: may need a separate variable for max initial acceleration convergence iterations @@ -754,11 +591,9 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Transfer inputs and calculate outputs for all modules (use current state) do i = 1, size(p%iModAll) - call FAST_InputSolve(ModData(p%iModAll(i)), m%Mappings, 1, & + call FAST_InputSolve(ModData(p%iModAll(i)), m%Mappings, IS_Input, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_CalcOutput(ModData(p%iModAll(i)), t_initial, STATE_CURR, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_MapOutputs(ModData(p%iModAll(i)), m%Mappings, & + call FAST_CalcOutput(ModData(p%iModAll(i)), m%Mappings, t_initial, STATE_CURR, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -923,8 +758,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM m%qn = m%q m%xn = m%x - ! Reset mappings updated flags - m%Mappings%Updated = .false. + ! Reset mapping ready flags + m%Mappings%Ready = .false. !------------------------------------------------------------------------- ! Option 2 Solve @@ -932,16 +767,12 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Loop through Option 2 modules do i = 1, size(p%iModOpt2) - call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, 1, & + call FAST_InputSolve(Mods(p%iModOpt2(i)), m%Mappings, IS_Input, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_UpdateStates(Mods(p%iModOpt2(i)), t_initial, n_t_global, m%xn, m%qn, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_CalcOutput(Mods(p%iModOpt2(i)), t_global_next, STATE_PRED, & + call FAST_CalcOutput(Mods(p%iModOpt2(i)), m%Mappings, t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - if (i < 2) then - call FAST_MapOutputs(Mods(p%iModOpt2(i)), m%Mappings, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return - end if end do !------------------------------------------------------------------------- @@ -950,7 +781,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Get inputs and update states for Option 1 modules not in Option 2 do i = 1, size(p%iModOpt1US) - call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, 1, & + call FAST_InputSolve(Mods(p%iModOpt1US(i)), m%Mappings, IS_Input, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return call FAST_UpdateStates(Mods(p%iModOpt1US(i)), t_initial, n_t_global, m%xn, m%qn, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return @@ -978,7 +809,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- do i = 1, size(p%iModOpt1) - call FAST_CalcOutput(Mods(p%iModOpt1(i)), t_global_next, STATE_PRED, & + call FAST_CalcOutput(Mods(p%iModOpt1(i)), m%Mappings, t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -997,7 +828,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Note: BuildJacobian resets these counters. if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0) .or. (n_t_global_next == 1)) then call BuildJacobian(p, m, Mods, t_global_next, n_t_global_next*100 + iterConv, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return end if !---------------------------------------------------------------------- @@ -1007,7 +839,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Calculate continuous state derivatives for tight coupling modules do i = 1, size(p%iModTC) call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_global_next, STATE_PRED, & - Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return + Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt) + if (Failed()) return end do ! Calculate difference between predicted and actual accelerations @@ -1015,10 +848,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer Option 1 outputs to temporary inputs and collect into u_tmp do i = 1, size(p%iModOpt1) - call FAST_MapOutputs(Mods(p%iModOpt1(i)), m%Mappings, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, 2, & - Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, IS_u, & + Turbine, ErrStat2, ErrMsg2) + if (Failed()) return end do call PackModuleUs(Mods, p%iModOpt1, Turbine, m%u_tmp) @@ -1035,7 +867,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- ! Solve Jacobian and RHS - call LAPACK_getrs('N', size(m%Jac, 1), m%Jac, m%IPIV, m%XB, ErrStat2, ErrMsg2); if (Failed()) return + call LAPACK_getrs('N', size(m%Jac, 1), m%Jac, m%IPIV, m%XB, ErrStat2, ErrMsg2) + if (Failed()) return !---------------------------------------------------------------------- ! Check perturbations for convergence and exit if below tolerance From fb6cc1fbc278d037cab28937407aed85e7831af1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 8 Sep 2023 12:25:31 +0000 Subject: [PATCH 43/61] Fix wrong variable bug in ModVar --- modules/nwtc-library/src/ModVar.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 57a430eb2e..c0a9fc7858 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -107,14 +107,14 @@ subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) end do ! Initialize input variables - if (.not. allocated(Vars%x)) allocate(Vars%u(0)) + if (.not. allocated(Vars%u)) allocate(Vars%u(0)) StartIndex = 1 do i = 1, size(Vars%u) call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize output variables - if (.not. allocated(Vars%x)) allocate(Vars%y(0)) + if (.not. allocated(Vars%y)) allocate(Vars%y(0)) StartIndex = 1 do i = 1, size(Vars%y) call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return From ed00cb5cc6ffec63b2a90755c3b173dd66817b4a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 8 Sep 2023 12:25:55 +0000 Subject: [PATCH 44/61] Add MV_InitVarsVals to AeroDyn --- modules/aerodyn/src/AeroDyn.f90 | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index ff5d6a1e86..2af6943ced 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -513,7 +513,26 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (Failed()) return; enddo end if - + + !............................................................................................ + ! Initialize Module Variables: + !............................................................................................ + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Associate pointers in initialization output + InitOut%Vars => p%Vars + + ! Initialize variables and values + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + !............................................................................................ ! Print the summary file if requested: !............................................................................................ From 5a8d9065a1f350d4707cf99a9ca0e234a313d11e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 9 Sep 2023 12:55:52 +0000 Subject: [PATCH 45/61] Integrated AeroDyn with ED, BD, and IfW --- modules/elastodyn/src/ElastoDyn.f90 | 22 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 5 + .../src/Registry_NWTC_Library.txt | 1 + .../src/Registry_NWTC_Library_base.txt | 1 + modules/openfast-library/src/FAST_Eval.f90 | 947 +++++++++++------- .../openfast-library/src/FAST_Registry.txt | 1 + modules/openfast-library/src/FAST_Types.f90 | 5 + modules/openfast-library/src/Solver.f90 | 51 +- 8 files changed, 667 insertions(+), 366 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index ac9102029f..3404fb1a4e 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -545,7 +545,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ! Blade Point Loads if (allocated(u%BladePtLoads)) then do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%u, "Blade "//trim(Num2LStr(i)), LoadFields, & + call MV_AddMeshVar(p%Vars%u, "BladeLoad"//trim(Num2LStr(i)), LoadFields, & Nodes=p%BldNodes, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) @@ -553,22 +553,22 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, end if ! Platform point loads - call MV_AddMeshVar(p%Vars%u, "Platform", LoadFields, & + call MV_AddMeshVar(p%Vars%u, "PlatformLoad", LoadFields, & Nodes=u%PlatformPtMesh%NNodes, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Tower point loads - call MV_AddMeshVar(p%Vars%u, "Tower", LoadFields, & + call MV_AddMeshVar(p%Vars%u, "TowerLoad", LoadFields, & Nodes=u%TowerPtLoads%Nnodes, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) ! Hub point loads - call MV_AddMeshVar(p%Vars%u, "Hub", LoadFields, & + call MV_AddMeshVar(p%Vars%u, "HubLoad", LoadFields, & Nodes=u%HubPtLoad%NNodes, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Nacelle point loads - call MV_AddMeshVar(p%Vars%u, "Nacelle", LoadFields, & + call MV_AddMeshVar(p%Vars%u, "NacelleLoad", LoadFields, & Nodes=u%NacelleLoads%NNodes, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) @@ -599,16 +599,16 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, if (allocated(y%BladeLn2Mesh))then do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade '//Num2LStr(i), MotionFields, Nodes=y%BladeLn2Mesh(i)%Nnodes, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'BladeMotion'//Num2LStr(i), MotionFields, Nodes=y%BladeLn2Mesh(i)%Nnodes, Flags=VF_Line) end do end if - call MV_AddMeshVar(p%Vars%y, 'Platform', MotionFields, Nodes=y%PlatformPtMesh%Nnodes) - call MV_AddMeshVar(p%Vars%y, 'Tower', MotionFields, Nodes=y%TowerLn2Mesh%Nnodes, Flags=VF_Line) - call MV_AddMeshVar(p%Vars%y, 'Hub', [VF_TransDisp, VF_Orientation, VF_AngularVel], Nodes=y%HubPtMotion%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'PlatformMotion', MotionFields, Nodes=y%PlatformPtMesh%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'TowerMotion', MotionFields, Nodes=y%TowerLn2Mesh%Nnodes, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'HubMotion', [VF_TransDisp, VF_Orientation, VF_AngularVel], Nodes=y%HubPtMotion%Nnodes) do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'Blade root '//Num2LStr(i), MotionFields, Nodes=y%BladeRootMotion(i)%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'BladeRootMotion'//Num2LStr(i), MotionFields, Nodes=y%BladeRootMotion(i)%Nnodes) end do - call MV_AddMeshVar(p%Vars%y, 'Nacelle', MotionFields, Nodes=y%NacelleMotion%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'NacelleMotion', MotionFields, Nodes=y%NacelleMotion%Nnodes) call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, LinNames=['Yaw, rad']) call MV_AddVar(p%Vars%y, 'YawRate', VF_Scalar, LinNames=['YawRate, rad/s']) call MV_AddVar(p%Vars%y, 'HSS_Spd', VF_Scalar, LinNames=['HSS_Spd, rad/s']) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index f403cb8819..2815058ba9 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -161,6 +161,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: ID = 0 !< Module identification number [-] character(ChanLen) :: Abbr !< Module name abbreviation [-] INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + LOGICAL :: IsTC = .false. !< Flag indicating module is part of tight coupling [-] REAL(R8Ki) :: DT = 0 !< Module time step [-] INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] @@ -1764,6 +1765,7 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, DstModDataTypeData%ID = SrcModDataTypeData%ID DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%IsTC = SrcModDataTypeData%IsTC DstModDataTypeData%DT = SrcModDataTypeData%DT DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps if (allocated(SrcModDataTypeData%ixs)) then @@ -1836,6 +1838,7 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) call RegPack(Buf, InData%ID) call RegPack(Buf, InData%Abbr) call RegPack(Buf, InData%Ins) + call RegPack(Buf, InData%IsTC) call RegPack(Buf, InData%DT) call RegPack(Buf, InData%SubSteps) call RegPack(Buf, allocated(InData%ixs)) @@ -1881,6 +1884,8 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Ins) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IsTC) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SubSteps) diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index a632d114ed..85b3c57a10 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -107,6 +107,7 @@ typedef ^ ModDataType IntKi Idx - 0 - typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index cc4c3dc347..d0b5cc9cd8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -107,6 +107,7 @@ typedef ^ ModDataType IntKi Idx - 0 - typedef ^ ^ IntKi ID - 0 - "Module identification number" - typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - typedef ^ ^ R8Ki DT - 0 - "Module time step" - typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 1e28f6f1d9..ff13af5a56 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -44,8 +44,8 @@ module FAST_Eval contains -subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat @@ -60,7 +60,7 @@ subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) ErrMsg = '' ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) case (Module_AD) @@ -74,13 +74,13 @@ subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) case (Module_BD) - call BD_Input_ExtrapInterp(T%BD%Input(:, Mod%Ins), T%BD%InputTimes(:, Mod%Ins), T%BD%u(Mod%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + call BD_Input_ExtrapInterp(T%BD%Input(:, ModData%Ins), T%BD%InputTimes(:, ModData%Ins), T%BD%u(ModData%Ins), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return do j = T%p_FAST%InterpOrder, 1, -1 - call BD_CopyInput(T%BD%Input(j, Mod%Ins), T%BD%Input(j + 1, Mod%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(j + 1, Mod%Ins) = T%BD%InputTimes(j, Mod%Ins) + call BD_CopyInput(T%BD%Input(j, ModData%Ins), T%BD%Input(j + 1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(j + 1, ModData%Ins) = T%BD%InputTimes(j, ModData%Ins) end do - call BD_CopyInput(T%BD%u(Mod%Ins), T%BD%Input(1, Mod%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(1, Mod%Ins) = t_global_next + call BD_CopyInput(T%BD%u(ModData%Ins), T%BD%Input(1, ModData%Ins), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + T%BD%InputTimes(1, ModData%Ins) = t_global_next case (Module_ED) @@ -152,7 +152,7 @@ subroutine FAST_ExtrapInterp(Mod, t_global_next, T, ErrStat, ErrMsg) T%SrvD%InputTimes(1) = t_global_next case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select @@ -163,8 +163,8 @@ logical function Failed() end function end subroutine -subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_InitIO(ModData, this_time, DT, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: this_time !< Initial simulation time (almost always 0) real(DbKi), intent(in) :: DT !< Glue code time step size type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -181,10 +181,10 @@ subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) ErrMsg = '' ! Copy state from current to predicted and initialze meshes - call FAST_CopyStates(Mod, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) case (Module_AD) @@ -196,11 +196,11 @@ subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) case (Module_BD) - T%BD%InputTimes(:, Mod%Ins) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + T%BD%InputTimes(:, ModData%Ins) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] do k = 2, T%p_FAST%InterpOrder + 1 - call BD_CopyInput(T%BD%Input(1, Mod%Ins), T%BD%Input(k, Mod%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyInput(T%BD%Input(1, ModData%Ins), T%BD%Input(k, ModData%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return end do - call BD_CopyInput(T%BD%Input(1, Mod%Ins), T%BD%u(Mod%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyInput(T%BD%Input(1, ModData%Ins), T%BD%u(ModData%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return case (Module_ED) @@ -254,7 +254,7 @@ subroutine FAST_InitIO(Mod, this_time, DT, T, ErrStat, ErrMsg) call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select @@ -265,12 +265,12 @@ logical function Failed() end function end subroutine -subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: t_initial !< Initial simulation time (almost always 0) integer(IntKi), intent(in) :: n_t_global !< Integer time step real(R8Ki), intent(inout) :: x_TC(:) !< Tight coupling state array - real(R8Ki), intent(inout) :: q_TC(:, :) !< Tight coupling state matrix + real(R8Ki), intent(inout) :: q_TC(:, :) !< Tight coupling state matrix type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -287,16 +287,16 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ErrMsg = '' ! Copy from current to predicted state (MESH_UPDATECOPY) - call FAST_CopyStates(Mod, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) case (Module_AD) - do j_ss = 1, Mod%SubSteps - n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 - t_module = n_t_module*Mod%DT + t_initial + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, T%AD%p, T%AD%x(STATE_PRED), & T%AD%xd(STATE_PRED), T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), T%AD%m, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -304,15 +304,15 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, case (Module_BD) ! Transfer tight coupling states to module - call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, STATE_PRED), T%BD%m(Mod%Ins)%Vals%x) - call XferGblToLoc1D(Mod%ixs, x_TC, T%BD%m(Mod%Ins)%Vals%x) - call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, STATE_PRED)) + call BD_PackStateValues(T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, STATE_PRED), T%BD%m(ModData%Ins)%Vals%x) + call XferGblToLoc1D(ModData%ixs, x_TC, T%BD%m(ModData%Ins)%Vals%x) + call BD_UnpackStateValues(T%BD%p(ModData%Ins), T%BD%m(ModData%Ins)%Vals%x, T%BD%x(ModData%Ins, STATE_PRED)) case (Module_ED) ! Transfer tight coupling states to module call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) - call XferGblToLoc1D(Mod%ixs, x_TC, T%ED%m%Vals%x) + call XferGblToLoc1D(ModData%ixs, x_TC, T%ED%m%Vals%x) call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(STATE_PRED)) ! Update the azimuth angle @@ -320,15 +320,15 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ! Transfer updated states to solver call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) - call XferLocToGbl1D(Mod%ixs, T%ED%m%Vals%x, x_TC) + call XferLocToGbl1D(ModData%ixs, T%ED%m%Vals%x, x_TC) ! case (Module_ExtPtfm) ! case (Module_FEAM) case (Module_HD) - do j_ss = 1, Mod%SubSteps - n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 - t_module = n_t_module*Mod%DT + t_initial + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input, T%HD%InputTimes, T%HD%p, T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), T%HD%m, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -337,9 +337,9 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ! case (Module_IceF) case (Module_IfW) - do j_ss = 1, Mod%SubSteps - n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 - t_module = n_t_module*Mod%DT + t_initial + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -350,9 +350,9 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ! case (Module_Orca) case (Module_SD) - do j_ss = 1, Mod%SubSteps - n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 - t_module = n_t_module*Mod%DT + t_initial + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial call SD_UpdateStates(t_module, n_t_module, T%SD%Input, T%SD%InputTimes, T%SD%p, T%SD%x(STATE_PRED), & T%SD%xd(STATE_PRED), T%SD%z(STATE_PRED), T%SD%OtherSt(STATE_PRED), T%SD%m, ErrStat2, ErrMsg2); if (Failed()) return end do @@ -360,15 +360,15 @@ subroutine FAST_UpdateStates(Mod, t_initial, n_t_global, x_TC, q_TC, T, ErrStat, ! case (Module_SeaSt) case (Module_SrvD) - do j_ss = 1, Mod%SubSteps - n_t_module = n_t_global*Mod%SubSteps + j_ss - 1 - t_module = n_t_module*Mod%DT + t_initial + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return end do case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select @@ -382,7 +382,7 @@ logical function Failed() subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) type(TC_MappingType), allocatable, intent(inout) :: Maps(:) type(ModDataType), intent(inout) :: Mods(:) !< Module data - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -390,9 +390,7 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: i - integer(IntKi) :: DstIns, SrcIns - integer(IntKi) :: iMap, ModIns, iModIn - logical, allocatable :: isActive(:) + integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst ErrStat = ErrID_None ErrMsg = '' @@ -409,92 +407,151 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) return end if - ! Loop through modules - do iMap = 1, size(Mods) + ! Loop through module pairings + do iModSrc = 1, size(Mods) + do iModDst = 1, size(Mods) + associate (ModSrc => Mods(iModSrc), ModDst => Mods(iModDst)) - ! Module instance - ModIns = Mods(iMap)%Ins + select case (ModDst%ID) - ! Switch based on module ID - select case (Mods(iMap)%ID) + case (Module_BD) ! BeamDyn Input ---------------------------------- - case (Module_AD) + select case (ModSrc%ID) + case (Module_ED) - call AddMotionMapping(Key='ED HubPtMotion -> AD HubMotion', & - SrcModID=Module_ED, SrcIns=1, SrcMeshName='Hub', & - DstModID=Module_AD, DstIns=1, DstMeshName='HubMotion', & - Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) + call MapMotionMesh(Key='ED BladeRoot -> BD RootMotion', & + SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//trim(Num2LStr(ModDst%Ins)), & + DstMod=ModDst, DstMeshName='RootMotion') - call AddMotionMapping(Key='ED HubPtMotion -> AD HubMotion', & - SrcModID=Module_ED, SrcIns=1, SrcMeshName='Hub', & - DstModID=Module_AD, DstIns=1, DstMeshName='HubMotion') + case (Module_AD) - case (Module_BD) + call MapLoadMesh(Key='AD BladeLoad -> BD BladeLoad', & + SrcMod=ModSrc, SrcMeshName='BladeLoad'//Num2LStr(ModDst%Ins), SrcDispMeshName='BladeMotion'//Num2LStr(i), & + DstMod=ModDst, DstMeshName='DistrLoad', DstDispMeshName='BladeMotion') - call AddMotionMapping(Key='ED BladeRoot -> BD RootMotion', & - SrcModID=Module_ED, SrcIns=1, SrcMeshName='Blade root '//trim(Num2LStr(ModIns)), & - DstModID=Module_BD, DstIns=ModIns, DstMeshName='RootMotion') + case (Module_SrvD) - call AddLoadMapping(Key='BD ReactionForce -> ED HubLoad', & - SrcModID=Module_BD, SrcIns=ModIns, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & - DstModID=Module_ED, DstIns=1, DstMeshName='Hub', DstDispMeshName='Hub') + end select - end select - end do + case (Module_ED) ! ElastoDyn Input -------------------------------- - !---------------------------------------------------------------------------- - ! Get module indices in ModData and determine which mappings are active - !---------------------------------------------------------------------------- + select case (ModSrc%ID) + case (Module_BD) - ! Allocate array to indicate if mapping is active and initialize to false - call AllocAry(isActive, size(Maps), "isActive", ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call MapLoadMesh(Key='BD ReactionForce -> ED HubLoad', & + SrcMod=ModSrc, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & + DstMod=ModDst, DstMeshName='HubLoad', DstDispMeshName='HubMotion') - isActive = .false. + case (Module_AD) - ! Loop through Maps - do iMap = 1, size(Maps) + if (T%p_FAST%CompElast == Module_ED) then + do i = 1, size(T%ED%Input(1)%BladePtLoads, 1) + call MapLoadMesh(Key='AD BladeLoad -> ED BladeLoad', Idx=i, & + SrcMod=ModSrc, SrcMeshName='BladeLoad'//Num2LStr(i), SrcDispMeshName='BladeMotion'//Num2LStr(i), & + DstMod=ModDst, DstMeshName='BladeLoad'//Num2LStr(i), DstDispMeshName='BladeMotion'//Num2LStr(i)) + end do + end if - ! Loop modules, if module ID matches source module ID - ! and module instance matches source module instance, exit loop - do ModIns = 1, size(Mods) - if ((Maps(iMap)%SrcModID == Mods(ModIns)%ID) .and. & - (Maps(iMap)%SrcIns == Mods(ModIns)%Ins)) exit - end do + call MapLoadMesh(Key='AD TowerLoad -> ED TowerLoad', & + SrcMod=ModSrc, SrcMeshName='TowerLoad', SrcDispMeshName='TowerMotion', & + DstMod=ModDst, DstMeshName='TowerLoad', DstDispMeshName='TowerMotion', & + Active=T%AD%y%rotors(1)%TowerLoad%committed) - ! Loop through modules, if module ID matches destination module ID - ! and module instance matches destinatino module instance, exit loop - do iModIn = 1, size(Mods) - if ((Maps(iMap)%DstModID == Mods(iModIn)%ID) .and. & - (Maps(iMap)%DstIns == Mods(iModIn)%Ins)) exit - end do + call MapLoadMesh(Key='AD NacelleLoad -> ED NacelleLoad', & + SrcMod=ModSrc, SrcMeshName='NacelleLoad', SrcDispMeshName='NacelleMotion', & + DstMod=ModDst, DstMeshName='NacelleLoad', DstDispMeshName='NacelleMotion', & + Active=T%AD%Input(1)%rotors(1)%NacelleMotion%committed) + + call MapLoadMesh(Key='AD HubLoad -> ED HubLoad', & + SrcMod=ModSrc, SrcMeshName='HubLoad', SrcDispMeshName='HubMotion', & + DstMod=ModDst, DstMeshName='HubLoad', DstDispMeshName='HubMotion', & + Active=T%AD%Input(1)%rotors(1)%HubMotion%committed) + + call MapLoadMesh(Key='AD TFinLoad -> ED TFinLoad', & + SrcMod=ModSrc, SrcMeshName='TFinLoad', SrcDispMeshName='TFinMotion', & + DstMod=ModDst, DstMeshName='TFinLoad', DstDispMeshName='TFinMotion', & + Active=T%AD%Input(1)%rotors(1)%TFinMotion%committed) + + case (Module_SrvD) + + end select + + case (Module_AD) ! AeroDyn Input ---------------------------------- + + select case (ModSrc%ID) + case (Module_ED) + + call MapMotionMesh(Key='ED TowerMotion -> AD TowerMotion', & + SrcMod=ModSrc, SrcMeshName='TowerMotion', & + DstMod=ModDst, DstMeshName='TowerMotion', & + Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) + + call MapMotionMesh(Key='ED HubMotion -> AD HubMotion', & + SrcMod=ModSrc, SrcMeshName='HubMotion', & + DstMod=ModDst, DstMeshName='HubMotion') - ! If input or output module not found, mapping is not active, cycle - if (ModIns > size(Mods) .or. iModIn > size(Mods)) cycle + call MapMotionMesh(Key='ED NacelleMotion -> AD NacelleMotion', & + SrcMod=ModSrc, SrcMeshName='NacelleMotion', & + DstMod=ModDst, DstMeshName='NacelleMotion', & + Active=T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) - ! Mark mapping as active - isActive(iMap) = .true. + call MapMotionMesh(Key='ED TFinMotion -> AD TFinMotion', & + SrcMod=ModSrc, SrcMeshName='TFinMotion', & + DstMod=ModDst, DstMeshName='TFinMotion', & + Active=T%AD%Input(1)%rotors(1)%TFinMotion%Committed) - ! Module input/ouput IDs and instances found, populate mapping - Maps(iMap)%SrcModIdx = ModIns - Maps(iMap)%DstModIdx = iModIn + do i = 1, size(T%ED%y%BladeRootMotion) + call MapMotionMesh(Key='ED BladeRootMotion -> AD BladeRootMotion', Idx=i, & + SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//Num2LStr(i), & + DstMod=ModDst, DstMeshName='BladeRootMotion'//Num2LStr(i)) + end do + + if (T%p_FAST%CompElast == Module_ED) then + do i = 1, size(T%ED%y%BladeLn2Mesh) + call MapMotionMesh(Key='ED BladeMotion -> AD BladeMotion', Idx=i, & + SrcMod=ModSrc, SrcMeshName='BladeMotion'//Num2LStr(i), & + DstMod=ModDst, DstMeshName='BladeMotion'//Num2LStr(i)) + end do + end if + + case (Module_BD) + + call MapMotionMesh(Key='BD BladeMotion -> AD BladeMotion', & + SrcMod=ModSrc, SrcMeshName='BladeMotion', & + DstMod=ModDst, DstMeshName='BladeMotion'//Num2LStr(i)) + + case (Module_SrvD) + + end select + + end select + end associate + end do + end do + + !---------------------------------------------------------------------------- + ! Get module indices in ModData and determine which mappings are active + !---------------------------------------------------------------------------- + + ! Loop through Maps + do iMap = 1, size(Maps) associate (Map => Maps(iMap), & SrcMod => Mods(Maps(iMap)%SrcModIdx), & DstMod => Mods(Maps(iMap)%DstModIdx)) - ! TODO: Add logic to check if mesh exists, skip mapping if it doesn't exist + ! If source and destination modules are not part of the tight coupling, cycle + ! if (.not. (SrcMod%IsTC .and. DstMod%IsTC)) cycle ! If load mapping if (Map%IsLoad) then ! Source mesh variable indices - Map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, Map%SrcMeshName, LoadFields(ModIns)), ModIns=1, size(LoadFields))] + Map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, Map%SrcMeshName, LoadFields(i)), i=1, size(LoadFields))] Map%SrcVarIdx = pack(Map%SrcVarIdx, Map%SrcVarIdx > 0) ! Destination mesh variable indices - Map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, Map%DstMeshName, LoadFields(ModIns)), ModIns=1, size(LoadFields))] + Map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, Map%DstMeshName, LoadFields(i)), i=1, size(LoadFields))] Map%DstVarIdx = pack(Map%DstVarIdx, Map%DstVarIdx > 0) ! Source displacement mesh is in input of source module (only translation displacement needed) @@ -504,36 +561,33 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) Map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, Map%DstDispMeshName, VF_TransDisp) ! Mark displacement variables with Solve flag - call SetFlags(SrcMod%Vars%u(Map%SrcDispVarIdx), VF_Solve) - call SetFlags(DstMod%Vars%y(Map%DstDispVarIdx), VF_Solve) + if (Map%SrcDispVarIdx > 0) call SetFlags(SrcMod%Vars%u(Map%SrcDispVarIdx), VF_Solve) + if (Map%DstDispVarIdx > 0) call SetFlags(DstMod%Vars%y(Map%DstDispVarIdx), VF_Solve) else ! Source mesh motion field variables - map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(ModIns)), ModIns=1, size(MotionFields))] + map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(i)), i=1, size(MotionFields))] map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) ! Destination mesh motion field variables - map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(ModIns)), ModIns=1, size(MotionFields))] + map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(i)), i=1, size(MotionFields))] map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) end if ! Mark variables with Solve flag - do ModIns = 1, size(map%SrcVarIdx) - call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(ModIns)), VF_Solve) + do i = 1, size(map%SrcVarIdx) + call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(i)), VF_Solve) end do - do ModIns = 1, size(map%DstVarIdx) - call SetFlags(DstMod%Vars%u(map%DstVarIdx(ModIns)), VF_Solve) + do i = 1, size(map%DstVarIdx) + call SetFlags(DstMod%Vars%u(map%DstVarIdx(i)), VF_Solve) end do end associate end do - ! Remove inactive mappings - Maps = pack(Maps, mask=isActive) - !---------------------------------------------------------------------------- ! Initialize Mapping meshes !---------------------------------------------------------------------------- @@ -541,69 +595,418 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Loop through mappings do i = 1, size(Maps) - ! Get output and input module instance indices - SrcIns = Maps(i)%SrcIns - DstIns = Maps(i)%DstIns - ! Select by mapping key select case (Maps(i)%Key) - case ('ED BladeRoot -> BD RootMotion') + case ('AD BladeLoad -> BD BladeLoad') + call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshMapCreate(T%ED%y%BladeRootMotion(DstIns), T%BD%Input(1, DstIns)%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - call MeshCopy(T%BD%Input(1, DstIns)%RootMotion, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + case ('AD BladeLoad -> ED BladeLoad') + call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%Idx), T%ED%Input(1)%BladePtLoads(Maps(i)%Idx), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + ! call MeshCopy(T%ED%Input(1)%BladePtLoads(Maps(i)%Idx), Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('AD NacelleLoad -> ED NacelleLoad') + call MeshMapCreate(T%AD%y%rotors(1)%NacelleLoad, T%ED%Input(1)%NacelleLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%ED%Input(1)%NacelleLoads, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('AD HubLoad -> ED HubLoad') + call MeshMapCreate(T%AD%y%rotors(1)%HubLoad, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('AD TFinLoad -> ED TFinLoad') + call MeshMapCreate(T%AD%y%rotors(1)%TFinLoad, T%ED%Input(1)%TFinCMLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('AD TowerLoad -> ED TowerLoad') + call MeshMapCreate(T%AD%y%rotors(1)%TowerLoad, T%ED%Input(1)%TowerPtLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%ED%Input(1)%TowerPtLoads, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('BD BladeMotion -> AD BladeMotion') + call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%BldMotion, T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return case ('BD ReactionForce -> ED HubLoad') + call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%ReactionForce, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED BladeMotion -> AD BladeMotion') + call MeshMapCreate(T%ED%y%BladeLn2Mesh(Maps(i)%Idx), T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%Idx), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED BladeRoot -> BD RootMotion') + call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED BladeRootMotion -> AD BladeRootMotion') + call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%Idx), T%AD%Input(1)%rotors(1)%BladeRootMotion(Maps(i)%Idx), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshMapCreate(T%BD%y(DstIns)%ReactionForce, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! Copy temporary mesh to transfer reaction force because actual mesh is needed to sum multiple forces - call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + case ('ED HubMotion -> AD HubMotion') + call MeshMapCreate(T%ED%y%HubPtMotion, T%AD%Input(1)%rotors(1)%HubMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED NacelleMotion -> AD NacelleMotion') + call MeshMapCreate(T%ED%y%NacelleMotion, T%AD%Input(1)%rotors(1)%NacelleMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED TFinMotion -> AD TFinMotion') + call MeshMapCreate(T%ED%y%TFinCMMotion, T%AD%Input(1)%rotors(1)%TFinMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED TowerMotion -> AD TowerMotion') + call MeshMapCreate(T%ED%y%TowerLn2Mesh, T%AD%Input(1)%rotors(1)%TowerMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return case default call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) return end select - end do contains - subroutine AddLoadMapping(Key, SrcModID, SrcIns, SrcMeshName, SrcDispMeshName, & - DstModID, DstIns, DstMeshName, DstDispMeshName, Active) - character(*), intent(in) :: Key - integer(IntKi), intent(in) :: SrcModID, DstModID - integer(IntKi), intent(in) :: SrcIns, DstIns - character(*), intent(in) :: SrcMeshName, DstMeshName - character(*), intent(in) :: SrcDispMeshName, DstDispMeshName - logical, optional, intent(in) :: Active + subroutine MapLoadMesh(Key, SrcMod, SrcMeshName, SrcDispMeshName, & + DstMod, DstMeshName, DstDispMeshName, Idx, Active) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + character(*), intent(in) :: SrcMeshName, DstMeshName + character(*), intent(in) :: SrcDispMeshName, DstDispMeshName + integer(IntKi), optional, intent(in) :: Idx + logical, optional, intent(in) :: Active + integer(IntKi) :: LocIdx if (present(Active)) then if (.not. Active) return end if + LocIdx = 0 + if (present(Idx)) LocIdx = Idx Maps = [Maps, TC_MappingType(Key=Key, isLoad=.true., & - SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & - DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] + SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName, & + Idx=LocIdx)] end subroutine - subroutine AddMotionMapping(Key, SrcModID, SrcIns, SrcMeshName, & - DstModID, DstIns, DstMeshName, Active) - character(*), intent(in) :: Key - integer(IntKi), intent(in) :: SrcModID, DstModID - integer(IntKi), intent(in) :: SrcIns, DstIns - character(*), intent(in) :: SrcMeshName, DstMeshName - logical, optional, intent(in) :: Active + + subroutine MapMotionMesh(Key, SrcMod, SrcMeshName, & + DstMod, DstMeshName, Idx, Active) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + character(*), intent(in) :: SrcMeshName, DstMeshName + integer(IntKi), optional, intent(in) :: Idx + logical, optional, intent(in) :: Active + integer(IntKi) :: LocIdx if (present(Active)) then if (.not. Active) return end if + LocIdx = 0 + if (present(Idx)) LocIdx = Idx Maps = [Maps, TC_MappingType(Key=Key, isLoad=.false., & - SrcModID=SrcModID, SrcIns=SrcIns, SrcMeshName=SrcMeshName, & - DstModID=DstModID, DstIns=DstIns, DstMeshName=DstMeshName)] + SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshName=SrcMeshName, & + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName, & + Idx=LocIdx)] end subroutine + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function + + logical function MapFailed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) + MapFailed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_InputSolve(ModData, Maps, Dst, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + integer(IntKi), intent(in) :: Dst + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Check that Dst is valid + if (Dst /= IS_Input .and. Dst /= IS_u) then + call SetErrStat(ErrID_Fatal, "Dst must be 1 or 2, given "//trim(Num2LStr(Dst)), ErrStat, ErrMsg, RoutineName) + return + end if + + ! Select based on destination module ID + select case (ModData%ID) + case (Module_AD) + if (Dst == IS_Input) then + call AD_InputSolve1(ModData, Maps, T%AD%Input(1), T, Errstat2, ErrMsg2) + else + call AD_InputSolve1(ModData, Maps, T%AD%u, T, Errstat2, ErrMsg2) + end if + case (Module_BD) + if (Dst == IS_Input) then + call BD_InputSolve1(ModData, Maps, T%BD%Input(1, ModData%Ins), T, Errstat2, ErrMsg2) + else + call BD_InputSolve1(ModData, Maps, T%BD%u(ModData%Ins), T, Errstat2, ErrMsg2) + end if + case (Module_ED) + if (Dst == IS_Input) then + call ED_InputSolve1(ModData, Maps, T%ED%Input(1), T, ErrStat2, ErrMsg2) + else + call ED_InputSolve1(ModData, Maps, T%ED%u, T, ErrStat2, ErrMsg2) + end if + case (Module_IfW) + if (Dst == IS_Input) then + call IfW_InputSolve1(ModData, Maps, T%IfW%Input(1), T, ErrStat2, ErrMsg2) + else + call IfW_InputSolve1(ModData, Maps, T%IfW%u, T, ErrStat2, ErrMsg2) + end if + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_CalcOutput(Mod, Maps, this_time, this_state, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine BD_InputSolve1(ModData, Maps, u_BD, T, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: u_BD + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mappings that set this module's inputs + do i = 1, size(Maps) + + ! If this is not the destination module, cycle + if (ModData%Idx /= Maps(i)%DstModIdx) cycle + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + select case (Maps(i)%Key) + case ('AD BladeLoad -> BD BladeLoad') + call Transfer_Line2_to_Line2(T%AD%y%rotors(1)%BladeLoad(Maps(i)%DstIns), & + u_BD%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), & + T%BD%y(Maps(i)%DstIns)%BldMotion) + + case ('ED BladeRoot -> BD RootMotion') + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%DstIns), & + u_BD%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + + ! Check for transfer errors and return if failed + if (ErrStat2 >= AbortErrLev) then + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) + return + end if + end do +end subroutine + +subroutine AD_InputSolve1(ModData, Maps, u_AD, T, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: u_AD + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'AD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mappings that set this module's inputs + do i = 1, size(Maps) + + ! If this is not the destination module, cycle + if (ModData%Idx /= Maps(i)%DstModIdx) cycle + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + select case (Maps(i)%Key) + case ('BD BladeMotion -> AD BladeMotion') + call Transfer_Line2_to_Line2(T%BD%y(Maps(i)%SrcIns)%BldMotion, & + u_AD%rotors(1)%BladeMotion(Maps(i)%SrcIns), & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED BladeMotion -> AD BladeMotion') + call Transfer_Line2_to_Line2(T%ED%y%BladeLn2Mesh(Maps(i)%Idx), & + u_AD%rotors(1)%BladeMotion(Maps(i)%Idx), & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED BladeRootMotion -> AD BladeRootMotion') + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%Idx), & + u_AD%rotors(1)%BladeRootMotion(Maps(i)%Idx), & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED HubMotion -> AD HubMotion') + call Transfer_Point_to_Point(T%ED%y%HubPtMotion, & + u_AD%rotors(1)%HubMotion, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED NacelleMotion -> AD NacelleMotion') + call Transfer_Point_to_Point(T%ED%y%NacelleMotion, & + u_AD%rotors(1)%NacelleMotion, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED TFinMotion -> AD TFinMotion') + call Transfer_Point_to_Point(T%ED%y%TFinCMMotion, & + u_AD%rotors(1)%TFinMotion, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED TowerMotion -> AD TowerMotion') + call Transfer_Line2_to_Line2(T%ED%y%TowerLn2Mesh, & + u_AD%rotors(1)%TowerMotion, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + + ! Check for transfer errors and return if failed + if (ErrStat2 >= AbortErrLev) then + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) + return + end if + end do +end subroutine + +subroutine ED_InputSolve1(ModData, Maps, u_ED, T, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: u_ED + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ED_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + logical :: ED_ResetHubLoadsFlag + logical :: ED_ResetNacelleLoadsFlag + + ErrStat = ErrID_None + ErrMsg = '' + + ED_ResetHubLoadsFlag = .true. + ED_ResetNacelleLoadsFlag = .true. + + ! Loop through mappings that set this module's inputs + do i = 1, size(Maps) + + ! If this is not the destination module, cycle + if (ModData%Idx /= Maps(i)%DstModIdx) cycle + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + select case (Maps(i)%Key) + case ('AD BladeLoad -> ED BladeLoad') + call Transfer_Line2_to_Point(T%AD%y%rotors(1)%BladeLoad(Maps(i)%Idx), & + u_ED%BladePtLoads(Maps(i)%Idx), & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%Idx), & + T%ED%y%BladeLn2Mesh(Maps(i)%Idx)) + + case ('AD NacelleLoad -> ED NacelleLoad') + call ED_ResetNacelleLoads() + call Transfer_Point_to_Point(T%AD%y%rotors(1)%NacelleLoad, & + Maps(i)%MeshTmp, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%NacelleMotion, & + T%ED%y%NacelleMotion) + u_ED%NacelleLoads%Force = u_ED%NacelleLoads%Force + Maps(i)%MeshTmp%Force + u_ED%NacelleLoads%Moment = u_ED%NacelleLoads%Moment + Maps(i)%MeshTmp%Moment + + case ('AD HubLoad -> ED HubLoad') + call ED_ResetHubLoads() + call Transfer_Point_to_Point(T%AD%y%rotors(1)%HubLoad, & + Maps(i)%MeshTmp, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%HubMotion, & + T%ED%y%HubPtMotion) + u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force + u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + + case ('AD TFinLoad -> ED TFinLoad') + call Transfer_Point_to_Point(T%AD%y%rotors(1)%TFinLoad, & + u_ED%TFinCMLoads, Maps(i)%MeshMap, & + ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%TFinMotion, & + T%ED%y%TFinCMMotion) + + case ('AD TowerLoad -> ED TowerLoad') + call Transfer_Line2_to_Point(T%AD%y%rotors(1)%TowerLoad, & + u_ED%TowerPtLoads, Maps(i)%MeshMap, & + ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%TowerMotion, & + T%ED%y%TowerLn2Mesh) + + case ('BD ReactionForce -> ED HubLoad') + call ED_ResetHubLoads() + call Transfer_Point_to_Point(T%BD%y(Maps(i)%SrcIns)%ReactionForce, & + Maps(i)%MeshTmp, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, Maps(i)%SrcIns)%RootMotion, & + T%ED%y%HubPtMotion) + u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force + u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + + case default + call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + return + end select + + ! Check for transfer errors and return if failed + if (ErrStat2 >= AbortErrLev) then + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) + return + end if + end do + +contains + subroutine ED_ResetHubLoads() + if (ED_ResetHubLoadsFlag) then + ED_ResetHubLoadsFlag = .false. + u_ED%HubPtLoad%Force = 0.0_ReKi + u_ED%HubPtLoad%Moment = 0.0_ReKi + end if + end subroutine + subroutine ED_ResetNacelleLoads() + if (ED_ResetNacelleLoadsFlag) then + ED_ResetNacelleLoadsFlag = .false. + u_ED%NacelleLoads%Force = 0.0_ReKi + u_ED%NacelleLoads%Moment = 0.0_ReKi + end if + end subroutine +end subroutine + +subroutine IfW_InputSolve1(ModData, Maps, u_IfW, T, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(inout) :: u_IfW + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + ErrStat = ErrID_None + ErrMsg = '' + +end subroutine + +subroutine FAST_CalcOutput(ModData, Maps, this_time, this_state, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data type(TC_MappingType), intent(inout) :: Maps(:) !< Output->Input mappings real(DbKi), intent(in) :: this_time !< Time integer(IntKi), intent(in) :: this_state !< State index @@ -620,7 +1023,7 @@ subroutine FAST_CalcOutput(Mod, Maps, this_time, this_state, T, ErrStat, ErrMsg) ErrMsg = '' ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) case (Module_AD) @@ -629,9 +1032,9 @@ subroutine FAST_CalcOutput(Mod, Maps, this_time, this_state, T, ErrStat, ErrMsg) case (Module_BD) - call BD_CalcOutput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & - T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & - T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return + call BD_CalcOutput(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), & + T%BD%xd(ModData%Ins, this_state), T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2); if (Failed()) return case (Module_ED) @@ -660,13 +1063,13 @@ subroutine FAST_CalcOutput(Mod, Maps, this_time, this_state, T, ErrStat, ErrMsg) T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select ! Set updated flag in mappings where this module is the source do i = 1, size(Maps) - if (Maps(i)%SrcModIdx == Mod%Idx) Maps(i)%Ready = .true. + if (Maps(i)%SrcModIdx == ModData%Idx) Maps(i)%Ready = .true. end do contains @@ -676,8 +1079,8 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMsg, dxdt) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_CalcContStateDeriv(ModData, this_time, this_state, T, ErrStat, ErrMsg, dxdt) + type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: this_time !< Time integer(IntKi), intent(in) :: this_state !< State index type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -693,18 +1096,18 @@ subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMs ErrMsg = '' ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) ! case (Module_AD) case (Module_BD) - call BD_CalcContStateDeriv(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), & - T%BD%xd(Mod%Ins, this_state), T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), & - T%BD%m(Mod%Ins), T%BD%dxdt(Mod%Ins), ErrStat2, ErrMsg2); if (Failed()) return + call BD_CalcContStateDeriv(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), & + T%BD%xd(ModData%Ins, this_state), T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), & + T%BD%m(ModData%Ins), T%BD%dxdt(ModData%Ins), ErrStat2, ErrMsg2); if (Failed()) return if (present(dxdt)) then - call BD_PackStateValues(T%BD%p(Mod%Ins), T%BD%dxdt(Mod%Ins), T%BD%m(Mod%Ins)%Vals%dxdt) - call XferLocToGbl1D(Mod%ixs, T%BD%m(Mod%Ins)%Vals%dxdt, dxdt) + call BD_PackStateValues(T%BD%p(ModData%Ins), T%BD%dxdt(ModData%Ins), T%BD%m(ModData%Ins)%Vals%dxdt) + call XferLocToGbl1D(ModData%ixs, T%BD%m(ModData%Ins)%Vals%dxdt, dxdt) end if case (Module_ED) @@ -714,7 +1117,7 @@ subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMs T%ED%dxdt, ErrStat2, ErrMsg2); if (Failed()) return if (present(dxdt)) then call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) - call XferLocToGbl1D(Mod%ixs, T%ED%m%Vals%dxdt, dxdt) + call XferLocToGbl1D(ModData%ixs, T%ED%m%Vals%dxdt, dxdt) end if ! case (Module_ExtPtfm) @@ -731,7 +1134,7 @@ subroutine FAST_CalcContStateDeriv(Mod, this_time, this_state, T, ErrStat, ErrMs ! case (Module_SeaSt) ! case (Module_SrvD) case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select @@ -742,8 +1145,8 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcJacobian(Mod, this_time, this_state, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_CalcJacobian(ModData, this_time, this_state, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) + type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: this_time !< Time integer(IntKi), intent(in) :: this_state !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -760,37 +1163,37 @@ subroutine FAST_CalcJacobian(Mod, this_time, this_state, T, ErrStat, ErrMsg, dYd ErrMsg = '' ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) ! case (Module_AD) case (Module_BD) - call BD_JacobianPInput(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & - T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & - ErrStat2, ErrMsg2, dYdu=T%BD%m(Mod%Ins)%Vals%dYdu, dXdu=T%BD%m(Mod%Ins)%Vals%dXdu); if (Failed()) return - if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%BD%m(Mod%Ins)%Vals%dYdu, dYdu) - if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%BD%m(Mod%Ins)%Vals%dXdu, dXdu) + call BD_JacobianPInput(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), T%BD%xd(ModData%Ins, this_state), & + T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & + ErrStat2, ErrMsg2, dYdu=T%BD%m(ModData%Ins)%Vals%dYdu, dXdu=T%BD%m(ModData%Ins)%Vals%dXdu); if (Failed()) return + if (present(dYdu)) call XferLocToGbl2D(ModData%iys, ModData%ius, T%BD%m(ModData%Ins)%Vals%dYdu, dYdu) + if (present(dXdu)) call XferLocToGbl2D(ModData%ixs, ModData%ius, T%BD%m(ModData%Ins)%Vals%dXdu, dXdu) - call BD_JacobianPContState(this_time, T%BD%Input(1, Mod%Ins), T%BD%p(Mod%Ins), T%BD%x(Mod%Ins, this_state), T%BD%xd(Mod%Ins, this_state), & - T%BD%z(Mod%Ins, this_state), T%BD%OtherSt(Mod%Ins, this_state), T%BD%y(Mod%Ins), T%BD%m(Mod%Ins), & - ErrStat2, ErrMsg2, dYdx=T%BD%m(Mod%Ins)%Vals%dYdx, dXdx=T%BD%m(Mod%Ins)%Vals%dXdx); if (Failed()) return - if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dYdx, dYdx) - if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%BD%m(Mod%Ins)%Vals%dXdx, dXdx) + call BD_JacobianPContState(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), T%BD%xd(ModData%Ins, this_state), & + T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & + ErrStat2, ErrMsg2, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return + if (present(dYdx)) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) + if (present(dXdx)) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) case (Module_ED) call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return - if (present(dYdu)) call XferLocToGbl2D(Mod%iys, Mod%ius, T%ED%m%Vals%dYdu, dYdu) - if (present(dXdu)) call XferLocToGbl2D(Mod%ixs, Mod%ius, T%ED%m%Vals%dXdu, dXdu) + if (present(dYdu)) call XferLocToGbl2D(ModData%iys, ModData%ius, T%ED%m%Vals%dYdu, dYdu) + if (present(dXdu)) call XferLocToGbl2D(ModData%ixs, ModData%ius, T%ED%m%Vals%dXdu, dXdu) call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return - if (present(dYdx)) call XferLocToGbl2D(Mod%iys, Mod%ixs, T%ED%m%Vals%dYdx, dYdx) - if (present(dXdx)) call XferLocToGbl2D(Mod%ixs, Mod%ixs, T%ED%m%Vals%dXdx, dXdx) + if (present(dYdx)) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) + if (present(dXdx)) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) ! case (Module_ExtPtfm) ! case (Module_FEAM) @@ -806,7 +1209,7 @@ subroutine FAST_CalcJacobian(Mod, this_time, this_state, T, ErrStat, ErrMsg, dYd ! case (Module_SeaSt) ! case (Module_SrvD) case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select @@ -817,14 +1220,14 @@ logical function Failed() end function end subroutine -subroutine FAST_SaveStates(Mod, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg ! Copy state from predicted to current with MESH_UPDATECOPY - call FAST_CopyStates(Mod, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) + call FAST_CopyStates(ModData, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) end subroutine subroutine XferLocToGbl1D(Inds, Loc, Gbl) @@ -859,8 +1262,8 @@ subroutine XferLocToGbl2D(RowInds, ColInds, Loc, Gbl) end do end subroutine -subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(in) :: Src, Dst !< State indices integer(IntKi), intent(in) :: CtrlCode !< Mesh copy code @@ -880,7 +1283,7 @@ subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) case (Module_AD) @@ -891,10 +1294,10 @@ subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) case (Module_BD) - call BD_CopyContState(T%BD%x(Mod%Ins, Src), T%BD%x(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyDiscState(T%BD%xd(Mod%Ins, Src), T%BD%xd(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyConstrState(T%BD%z(Mod%Ins, Src), T%BD%z(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - call BD_CopyOtherState(T%BD%OtherSt(Mod%Ins, Src), T%BD%OtherSt(Mod%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyContState(T%BD%x(ModData%Ins, Src), T%BD%x(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyDiscState(T%BD%xd(ModData%Ins, Src), T%BD%xd(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyConstrState(T%BD%z(ModData%Ins, Src), T%BD%z(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call BD_CopyOtherState(T%BD%OtherSt(ModData%Ins, Src), T%BD%OtherSt(ModData%Ins, Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case (Module_ED) @@ -942,7 +1345,7 @@ subroutine FAST_CopyStates(Mod, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) call SrvD_CopyOtherState(T%SrvD%OtherSt(Src), T%SrvD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mod%ID)), ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select @@ -953,8 +1356,8 @@ logical function Failed() end function end subroutine -subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data +subroutine FAST_ResetRemapFlags(ModData, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: ModData !< Module data type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -968,7 +1371,7 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) ErrMsg = '' ! Select based on module ID - select case (Mod%ID) + select case (ModData%ID) case (Module_AD) @@ -1003,13 +1406,13 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) case (Module_BD) - T%BD%Input(1, Mod%Ins)%RootMotion%RemapFlag = .false. - T%BD%Input(1, Mod%Ins)%PointLoad%RemapFlag = .false. - T%BD%Input(1, Mod%Ins)%DistrLoad%RemapFlag = .false. - T%BD%Input(1, Mod%Ins)%HubMotion%RemapFlag = .false. + T%BD%Input(1, ModData%Ins)%RootMotion%RemapFlag = .false. + T%BD%Input(1, ModData%Ins)%PointLoad%RemapFlag = .false. + T%BD%Input(1, ModData%Ins)%DistrLoad%RemapFlag = .false. + T%BD%Input(1, ModData%Ins)%HubMotion%RemapFlag = .false. - T%BD%y(Mod%Ins)%ReactionForce%RemapFlag = .false. - T%BD%y(Mod%Ins)%BldMotion%RemapFlag = .false. + T%BD%y(ModData%Ins)%ReactionForce%RemapFlag = .false. + T%BD%y(ModData%Ins)%BldMotion%RemapFlag = .false. case (Module_ED) @@ -1059,9 +1462,9 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) case (Module_IceD) - if (T%IceD%Input(1, Mod%Ins)%PointMesh%Committed) then - T%IceD%Input(1, Mod%Ins)%PointMesh%RemapFlag = .false. - T%IceD%y(Mod%Ins)%PointMesh%RemapFlag = .false. + if (T%IceD%Input(1, ModData%Ins)%PointMesh%Committed) then + T%IceD%Input(1, ModData%Ins)%PointMesh%RemapFlag = .false. + T%IceD%y(ModData%Ins)%PointMesh%RemapFlag = .false. end if case (Module_IceF) @@ -1071,8 +1474,6 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) T%IceF%y%iceMesh%RemapFlag = .false. end if -! case (Module_IfW) - case (Module_MAP) T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. @@ -1083,8 +1484,6 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. T%MD%y%CoupledLoads(1)%RemapFlag = .false. -! case (Module_OpFM) - case (Module_Orca) T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. @@ -1103,137 +1502,8 @@ subroutine FAST_ResetRemapFlags(Mod, T, ErrStat, ErrMsg) T%SD%y%Y3Mesh%RemapFlag = .false. end if -! case (Module_SeaSt) - -! case (Module_SrvD) - end select -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function -end subroutine - -subroutine FAST_InputSolve(Mod, Maps, Dst, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: Mod !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - integer(IntKi), intent(in) :: Dst - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'FAST_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i, j, k - integer(IntKi) :: DstIns, SrcIns - type(ED_InputType), pointer :: u_ED - type(BD_InputType), pointer :: u_BD - logical :: ED_ResetHubPtLoad - - ErrStat = ErrID_None - ErrMsg = '' - - ! Check that Dst is valid - if (Dst /= 1 .and. Dst /= 2) then - call SetErrStat(ErrID_Fatal, "Dst must be 1 or 2, given "//trim(Num2LStr(Dst)), ErrStat, ErrMsg, RoutineName) - return - end if - - select case (Mod%ID) - - case (Module_AD) - - case (Module_BD) - - select case (Dst) - case (IS_Input) - u_BD => T%BD%Input(1, Mod%Ins) - case (IS_u) - u_BD => T%BD%u(Mod%Ins) - end select - - ! u_BD%DistrLoad%Force = 0.0_ReKi - ! u_BD%DistrLoad%Moment = 0.0_ReKi - - ! u_BD%PointLoad%Force = 0.0_ReKi - ! u_BD%PointLoad%Moment = 0.0_ReKi - - case (Module_ED) - - select case (Dst) - case (IS_Input) - u_ED => T%ED%Input(1) - case (IS_u) - u_ED => T%ED%u - end select - - ED_ResetHubPtLoad = .true. - - ! u_ED%NacelleLoads%Force = 0.0_ReKi - ! u_ED%NacelleLoads%Moment = 0.0_ReKi - - ! u_ED%TowerPtLoads%Force = 0.0_ReKi - ! u_ED%TowerPtLoads%Moment = 0.0_ReKi - - ! u_ED%TwrAddedMass = 0.0_ReKi - ! u_ED%PtfmAddedMass = 0.0_ReKi - - case (Module_IfW) - - case (Module_SrvD) - - end select - - ! Loop through mappings that set this module's inputs - do i = 1, size(Maps) - - ! If this is not the destination module, cycle - if (Mod%Idx /= Maps(i)%DstModIdx) cycle - - ! If mapping source has not been calculated, cycle - if (.not. Maps(i)%Ready) cycle - - ! Get source and destination module instances - SrcIns = Maps(i)%SrcIns - DstIns = Maps(i)%DstIns - - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Maps(i)%Key) - - case ('ED BladeRoot -> BD RootMotion') - - call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(DstIns), u_BD%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2) - if (Failed()) return - - case ('BD ReactionForce -> ED HubLoad') - - if (ED_ResetHubPtLoad) then - u_ED%HubPtLoad%Force = 0.0_ReKi - u_ED%HubPtLoad%Moment = 0.0_ReKi - ED_ResetHubPtLoad = .false. - end if - - call Transfer_Point_to_Point(T%BD%y(SrcIns)%ReactionForce, Maps(i)%MeshTmp, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & - T%BD%Input(1, SrcIns)%RootMotion, T%ED%y%HubPtMotion) - if (Failed()) return - - u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force - u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment - - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) - return - end select - end do - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function end subroutine subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMsg, dUdu, dUdy) @@ -1245,7 +1515,7 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMs character(*), intent(out) :: ErrMsg real(R8Ki), optional, intent(inout) :: dUdu(:, :), dUdy(:, :) - character(*), parameter :: RoutineName = 'FAST_InputSolve' + character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 integer(IntKi) :: j, k @@ -1257,8 +1527,9 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMs ! Loop through mapping array do j = 1, size(Mappings) - ! If mapping input and output modules are not in module order array, cycle - if (all(Mappings(j)%DstModIdx /= ModOrder) .and. all(Mappings(j)%SrcModIdx /= ModOrder)) cycle + ! If source and destination modules are not in tight coupling, cycle + if ((.not. ModData(Mappings(j)%DstModIdx)%IsTC) .or. & + (.not. ModData(Mappings(j)%SrcModIdx)%IsTC)) cycle ! Get input/output module instances iiu = Mappings(j)%DstIns diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index f45fa17254..aa09685318 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -106,6 +106,7 @@ typedef ^ ^ IntKi SrcVarIdx : - - typedef ^ ^ IntKi DstVarIdx : - - "motion variable index" - typedef ^ ^ IntKi SrcDispVarIdx - - - "source displacement var index [if IsLoad=true]" - typedef ^ ^ IntKi DstDispVarIdx - - - "destination displacement var index [if IsLoad=true]" - +typedef ^ ^ IntKi Idx - - - "Optional index for specifying transfers" - typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from output variable to input variable" - typedef ^ ^ logical IsLoad - - - "Flag indicating if this is a load or motion mapping" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index c1f5ae8122..4997bfbe1e 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -126,6 +126,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstVarIdx !< motion variable index [-] INTEGER(IntKi) :: SrcDispVarIdx = 0_IntKi !< source displacement var index [if IsLoad=true] [-] INTEGER(IntKi) :: DstDispVarIdx = 0_IntKi !< destination displacement var index [if IsLoad=true] [-] + INTEGER(IntKi) :: Idx = 0_IntKi !< Optional index for specifying transfers [-] TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from output variable to input variable [-] LOGICAL :: IsLoad = .false. !< Flag indicating if this is a load or motion mapping [-] @@ -1554,6 +1555,7 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, end if DstTC_MappingTypeData%SrcDispVarIdx = SrcTC_MappingTypeData%SrcDispVarIdx DstTC_MappingTypeData%DstDispVarIdx = SrcTC_MappingTypeData%DstDispVarIdx + DstTC_MappingTypeData%Idx = SrcTC_MappingTypeData%Idx call MeshCopy(SrcTC_MappingTypeData%MeshTmp, DstTC_MappingTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1613,6 +1615,7 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) end if call RegPack(Buf, InData%SrcDispVarIdx) call RegPack(Buf, InData%DstDispVarIdx) + call RegPack(Buf, InData%Idx) call MeshPack(Buf, InData%MeshTmp) call NWTC_Library_PackMeshMapType(Buf, InData%MeshMap) call RegPack(Buf, InData%IsLoad) @@ -1682,6 +1685,8 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstDispVarIdx) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Idx) + if (RegCheckErr(Buf, RoutineName)) return call MeshUnpack(Buf, OutData%MeshTmp) ! MeshTmp call NWTC_Library_UnpackMeshMapType(Buf, OutData%MeshMap) ! MeshMap call RegUnpack(Buf, OutData%IsLoad) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 5507e88807..9ae9bba333 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -104,6 +104,9 @@ subroutine Solver_Init(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Indices of BeamDyn modules p%iModBD = [pack(modInds, ModIDs == Module_BD)] + ! Set tight coupling flag to true for tight coupling modules + Mods(p%iModTC)%IsTC = .true. + !---------------------------------------------------------------------------- ! Initialize mesh mappings (must be done before calculating global indices) !---------------------------------------------------------------------------- @@ -880,7 +883,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call Solver_Step_Debug(p, m, n_t_global_next, iterCorr, iterConv, delta_norm) end if - if (delta_norm < p%ConvTol) exit + ! If at least one convergence iteration has been done and + ! the RHS norm is less than convergence tolerance, exit loop + if ((iterConv > 0) .and. (delta_norm < p%ConvTol)) exit ! Remove conditioning m%XB(p%iJL, 1) = m%XB(p%iJL, 1)*p%Scale_UJac @@ -1037,6 +1042,8 @@ subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) m%IterUntilUJac = p%NIter_UJac m%StepsUntilUJac = p%NStep_UJac + if (size(m%Jac) == 0) return + !---------------------------------------------------------------------------- ! Get module Jacobians and assemble !---------------------------------------------------------------------------- @@ -1390,16 +1397,16 @@ subroutine Solver_Init_Debug(p, m, Mods) type(ModDataType), intent(in) :: Mods(:) !< Module data integer(IntKi) :: i, j - write (DebugUn, '(A,*(I4))') " p%iJX2 = ", p%iJX - write (DebugUn, '(A,*(I4))') " p%iJUT = ", p%iJUT - write (DebugUn, '(A,*(I4))') " p%iJU = ", p%iJU - write (DebugUn, '(A,*(I4))') " p%iJL = ", p%iJL - write (DebugUn, '(A,*(I4))') " p%iX2 = ", p%iX2 - write (DebugUn, '(A,*(I4))') " p%iX1 = ", p%iX1 - write (DebugUn, '(A,*(I4))') " p%iUT = ", p%iUT - write (DebugUn, '(A,*(I4))') " p%iU1 = ", p%iU1 - write (DebugUn, '(A,*(I4))') " p%iyT = ", p%iyT - write (DebugUn, '(A,*(I4))') " p%iy1 = ", p%iy1 + write (DebugUn, '(A,*(I6))') " p%iJX2 = ", p%iJX + write (DebugUn, '(A,*(I6))') " p%iJUT = ", p%iJUT + write (DebugUn, '(A,*(I6))') " p%iJU = ", p%iJU + write (DebugUn, '(A,*(I6))') " p%iJL = ", p%iJL + write (DebugUn, '(A,*(I6))') " p%iX2 = ", p%iX2 + write (DebugUn, '(A,*(I6))') " p%iX1 = ", p%iX1 + write (DebugUn, '(A,*(I6))') " p%iUT = ", p%iUT + write (DebugUn, '(A,*(I6))') " p%iU1 = ", p%iU1 + write (DebugUn, '(A,*(I6))') " p%iyT = ", p%iyT + write (DebugUn, '(A,*(I6))') " p%iy1 = ", p%iy1 write (DebugUn, *) "shape(m%dYdx) = ", shape(m%dYdx) write (DebugUn, *) "shape(m%dYdu) = ", shape(m%dYdu) write (DebugUn, *) "shape(m%dXdx) = ", shape(m%dXdx) @@ -1414,24 +1421,34 @@ subroutine Solver_Init_Debug(p, m, Mods) if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" - write (DebugUn, '(A,*(I4))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc - write (DebugUn, '(A,*(I4))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol + write (DebugUn, '(A,*(I6))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc + write (DebugUn, '(A,*(I6))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol end do do j = 1, size(Mods(i)%Vars%u) if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" - write (DebugUn, '(A,*(I4))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc - write (DebugUn, '(A,*(I4))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol + write (DebugUn, '(A,*(I6))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc + write (DebugUn, '(A,*(I6))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol end do do j = 1, size(Mods(i)%Vars%y) if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" - write (DebugUn, '(A,*(I4))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc - write (DebugUn, '(A,*(I4))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol + write (DebugUn, '(A,*(I6))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc + write (DebugUn, '(A,*(I6))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol end do end do + + do i = 1, size(m%Mappings) + associate (SrcMod => Mods(m%Mappings(i)%SrcModIdx), & + DstMod => Mods(m%Mappings(i)%DstModIdx)) + write (DebugUn, *) "Mapping = "//m%Mappings(i)%Key + write (DebugUn, *) " Src = "//trim(SrcMod%Abbr)//' Ins:'//trim(num2lstr(SrcMod%Ins))//' ModIdx:'//trim(num2lstr(SrcMod%Idx)) + write (DebugUn, *) " Dst = "//trim(DstMod%Abbr)//' Ins:'//trim(num2lstr(DstMod%Ins))//' ModIdx:'//trim(num2lstr(DstMod%Idx)) + if (m%Mappings(i)%Idx /= 0) write (DebugUn, *) " Idx = "//trim(num2lstr(m%Mappings(i)%Idx)) + end associate + end do end subroutine subroutine Solver_Step_Debug(p, m, step, iterCorr, iterConv, delta_norm) From 3aae012ee8dfc271c8f5b3c12225ac1ed0b7d766 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Sep 2023 15:40:32 +0000 Subject: [PATCH 46/61] Add SrvD to TC, cleanup TC, extend mappings Lots of development to make TC faster and easier to understand --- modules/aerodyn/src/AeroDyn.f90 | 217 ++- modules/beamdyn/src/BeamDyn.f90 | 47 +- modules/beamdyn/src/Driver_Beam_Subs.f90 | 13 +- modules/elastodyn/src/ElastoDyn.f90 | 99 +- modules/nwtc-library/src/ModVar.f90 | 78 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 189 ++- .../src/Registry_NWTC_Library.txt | 11 +- .../src/Registry_NWTC_Library_base.txt | 11 +- modules/openfast-library/src/FAST_Eval.f90 | 1256 +++++++++++------ .../openfast-library/src/FAST_Registry.txt | 36 +- modules/openfast-library/src/FAST_Types.f90 | 146 +- modules/openfast-library/src/Solver.f90 | 186 +-- modules/servodyn/src/ServoDyn.f90 | 101 ++ 13 files changed, 1630 insertions(+), 760 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 2af6943ced..26af73dfb8 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -518,20 +518,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Initialize Module Variables: !............................................................................................ - ! Allocate space for variables (deallocate if already allocated) - if (associated(p%Vars)) deallocate(p%Vars) - allocate(p%Vars, stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Associate pointers in initialization output - InitOut%Vars => p%Vars - - ! Initialize variables and values - CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2) - if (Failed()) return + call Init_ModuleVars(InitInp, u, p, y, m, InitOut, errStat2, errMsg2); if (Failed()) return !............................................................................................ ! Print the summary file if requested: @@ -621,6 +608,208 @@ subroutine AD_ReInit(p, x, xd, z, OtherState, m, Interval, ErrStat, ErrMsg ) end subroutine AD_ReInit !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes module variables for use by the solver and linearization. +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) + TYPE(AD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(AD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(AD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i, j, k + character(4) :: RotorStr + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + ! Loop through rotors + do i = 1, size(InitInp%rotors) + + RotorStr = 'R'//trim(Num2LStr(i)) + + associate(rp => p%rotors(i), & + ru => u%rotors(i), & + ry => y%rotors(i), & + rInitOut => InitOut%rotors(i)) + + !---------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------- + + + !---------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------- + + ! Add tower motion + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"TowerMotion", & + Nodes=ru%TowerMotion%NNodes, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel]) + + ! Add nacelle motion + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"NacelleMotion", & + Nodes=ru%NacelleMotion%NNodes, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel]) + + ! Add hub motion + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"HubMotion", & + Nodes=ru%HubMotion%NNodes, & + Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel]) + + ! Add blade root motion + do j = 1, rp%NumBlades + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"BladeRootMotion"//IdxStr(j), & + Nodes=ru%BladeRootMotion(j)%NNodes, & + Fields=[VF_Orientation]) + end do + + ! Add blade motion + do j = 1, rp%NumBlades + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"BladeMotion"//IdxStr(j), & + Nodes=ru%BladeMotion(j)%NNodes, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc]) + end do + + ! Add user props + do j = 1, size(ru%UserProp,2) + do k = 1, size(ru%UserProp,1) + call MV_AddVar(p%Vars%u, trim(RotorStr)//"UserProp"//IdxStr(j, k), VF_Scalar, iUsr=j, jUsr=k) + end do + end do + + !---------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------- + + ! Add tower load + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"TowerLoad", LoadFields, & + Nodes=ry%TowerLoad%NNodes) + + ! Add nacelle load + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"HubLoad", LoadFields, & + Nodes=ry%HubLoad%NNodes) + + ! Add nacelle load + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"NacelleLoad", LoadFields, & + Nodes=ry%NacelleLoad%NNodes) + + ! Loop through blades + do j = 1, rp%NumBlades + + ! Add blade load + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"BladeLoad"//IdxStr(j), LoadFields, & + Nodes=ry%BladeLoad(j)%NNodes) + end do + + ! Rotor outputs + do j = 1, rp%NumOuts + call MV_AddVar(p%Vars%y, rInitOut%WriteOutputHdr(j), VF_Scalar, & + Flags=OutParamFlags(rp%OutParam(j)%Indx), & + iUsr=j, & + LinNames=[trim(rInitOut%WriteOutputHdr(j))//', '//trim(rInitOut%WriteOutputUnt(j))]) + end do + + ! Blade node outputs + do j = rp%NumOuts + 1, rp%NumOuts + rp%BldNd_TotNumOuts + call MV_AddVar(p%Vars%y, rInitOut%WriteOutputHdr(j), VF_Scalar, & + Flags=VF_RotFrame, & + iUsr=k, & + LinNames=[trim(rInitOut%WriteOutputHdr(j))//', '//trim(rInitOut%WriteOutputUnt(j))]) + end do + + end associate + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + ! if (.not. InitInp%Linearize) return + ! TODO: Use modvars for linearization + return + + ! Loop through rotors + do i = 1, size(InitInp%rotors) + + ! State Variables + call AllocAry(InitOut%rotors(i)%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%rotors(i)%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%rotors(i)%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + InitOut%rotors(i)%DerivOrder_x = 2 + do j = 1, size(p%Vars%x) + do k = 1, p%Vars%x(j)%Num + InitOut%rotors(i)%LinNames_x(p%Vars%x(j)%iLoc) = p%Vars%x(j)%LinNames + InitOut%rotors(i)%RotFrame_x(p%Vars%x(j)%iLoc) = iand(p%Vars%x(j)%Flags, VF_RotFrame) > 0 + end do + end do + + ! Input Variables + call AllocAry(InitOut%rotors(i)%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%rotors(i)%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%rotors(i)%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + do j = 1, size(p%Vars%u) + do k = 1, p%Vars%u(j)%Num + InitOut%rotors(i)%LinNames_u(p%Vars%u(j)%iLoc) = p%Vars%u(j)%LinNames + InitOut%rotors(i)%RotFrame_u(p%Vars%u(j)%iLoc) = iand(p%Vars%u(j)%Flags, VF_RotFrame) > 0 + InitOut%rotors(i)%IsLoad_u(p%Vars%u(j)%iLoc) = iand(p%Vars%u(j)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + call AllocAry(InitOut%rotors(i)%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%rotors(i)%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + do j = 1, size(p%Vars%y) + do k = 1, p%Vars%y(j)%Num + InitOut%rotors(i)%LinNames_y(p%Vars%y(j)%iLoc) = p%Vars%y(j)%LinNames + InitOut%rotors(i)%RotFrame_y(p%Vars%y(j)%iLoc) = iand(p%Vars%y(j)%Flags, VF_RotFrame) > 0 + end do + end do + end do + +contains + + pure integer(IntKi) function OutParamFlags(idx) + integer(IntKi), intent(in) :: idx + integer(IntKi), parameter :: RotFrameInds(*) = [& + BAzimuth, BPitch, & + BNVUndx, BNVUndy, BNVUndz, BNVDisx, BNVDisy, BNVDisz, BNSTVx, BNSTVy, & + BNSTVz, BNVRel, BNDynP, BNRe, BNM, BNVIndx, BNVIndy, BNAxInd, BNTnInd, & + BNAlpha, BNTheta, BNPhi, BNCurve, BNCl, BNCd, BNCm, BNCx, BNCy, BNCn, & + BNCt, BNFl, BNFd, BNMm, BNFx, BNFy, BNFn, BNFt, BNClrnc] + if (any(RotFrameInds == idx)) then + OutParamFlags = VF_RotFrame + else + OutParamFlags = VF_None + end if + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) type(RotMiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 7202873b23..9a8e88d384 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -317,13 +317,13 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) Describe = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, Num=3, Flags=flags, & - iUsr=[i], & + iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(Describe)//' translational displacement in X, m', & trim(Describe)//' translational displacement in Y, m', & trim(Describe)//' translational displacement in Z, m']) call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, Num=3, Flags=flags, & - iUsr=[i], & + iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(Describe)//' rotational displacement in X, rad', & trim(Describe)//' rotational displacement in Y, rad', & @@ -334,13 +334,13 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) Describe = 'First time derivative of finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransVel, Num=3, Flags=flags, & - iUsr=[i], & + iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(Describe)//' translational displacement in X, m/s', & trim(Describe)//' translational displacement in Y, m/s', & trim(Describe)//' translational displacement in Z, m/s']) call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_AngularVel, Num=3, Flags=flags, & - iUsr=[i], & + iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(Describe)//' rotational displacement in X, rad/s', & trim(Describe)//' rotational displacement in Y, rad/s', & @@ -379,19 +379,18 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) call MV_AddMeshVar(p%Vars%y, 'BladeMotion', MotionFields, Nodes=y%BldMotion%Nnodes) do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & - Num=1, & Flags=OutParamFlags(p%OutParam(i)%Indx), & - iUsr=[i], & + iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=p%OutParam(i)%Indx > 0) end do do i = 1, p%BldNd_NumOuts - call MV_AddVar(p%Vars%y, 'Node'//p%BldNd_OutParam(i)%Name, VF_Scalar, & - Num=size(p%BldNd_BlOutNd), & - Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & - iUsr=[(j, j=1,size(p%BldNd_BlOutNd))] + p%NumOuts + (i-1)*size(p%BldNd_BlOutNd), & - LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & - Active=p%BldNd_OutParam(i)%Indx > 0) + ! call MV_AddVar(p%Vars%y, 'Node'//p%BldNd_OutParam(i)%Name, VF_Scalar, & + ! Num=size(p%BldNd_BlOutNd), & + ! Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & + ! iUsr=[(j, j=1,size(p%BldNd_BlOutNd))] + p%NumOuts + (i-1)*size(p%BldNd_BlOutNd), & + ! LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & + ! Active=p%BldNd_OutParam(i)%Indx > 0) end do !---------------------------------------------------------------------------- @@ -6052,6 +6051,10 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If variable is for extended linearization, skip if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle + ! If variable is for extended linearization, skip + ! TODO: Remove for linearization + if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -6090,6 +6093,10 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If extended linearization variable, skip if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle + ! If variable is for extended linearization, skip + ! TODO: Remove for linearization + if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -6822,13 +6829,13 @@ subroutine BD_PackStateValues(p, x, Values) do i = 1, size(p%Vars%x) select case(p%Vars%x(i)%Field) case (VF_TransDisp) - Values(p%Vars%x(i)%iLoc) = x%q(1:3,p%Vars%x(i)%iUsr(1)) ! XYZ displacement + Values(p%Vars%x(i)%iLoc) = x%q(1:3,p%Vars%x(i)%iUsr) ! XYZ displacement case (VF_TransVel) - Values(p%Vars%x(i)%iLoc) = x%dqdt(1:3,p%Vars%x(i)%iUsr(1)) ! XYZ velocity + Values(p%Vars%x(i)%iLoc) = x%dqdt(1:3,p%Vars%x(i)%iUsr) ! XYZ velocity case (VF_Orientation) - Values(p%Vars%x(i)%iLoc) = x%q(4:6,p%Vars%x(i)%iUsr(1)) ! WM parameters + Values(p%Vars%x(i)%iLoc) = x%q(4:6,p%Vars%x(i)%iUsr) ! WM parameters case (VF_AngularVel) - Values(p%Vars%x(i)%iLoc) = x%dqdt(4:6,p%Vars%x(i)%iUsr(1)) ! Angular velocity + Values(p%Vars%x(i)%iLoc) = x%dqdt(4:6,p%Vars%x(i)%iUsr) ! Angular velocity end select end do end subroutine @@ -6841,13 +6848,13 @@ subroutine BD_UnpackStateValues(p, Values, x) do i = 1, size(p%Vars%x) select case(p%Vars%x(i)%Field) case (VF_TransDisp) - x%q(1:3,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! XYZ displacement + x%q(1:3,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! XYZ displacement case (VF_TransVel) - x%dqdt(1:3,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! XYZ velocity + x%dqdt(1:3,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! XYZ velocity case (VF_Orientation) - x%q(4:6,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! WM parameters + x%q(4:6,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! WM parameters case (VF_AngularVel) - x%dqdt(4:6,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! Angular velocity + x%dqdt(4:6,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! Angular velocity end select end do end subroutine diff --git a/modules/beamdyn/src/Driver_Beam_Subs.f90 b/modules/beamdyn/src/Driver_Beam_Subs.f90 index 27e535105f..d390f4fc3b 100644 --- a/modules/beamdyn/src/Driver_Beam_Subs.f90 +++ b/modules/beamdyn/src/Driver_Beam_Subs.f90 @@ -641,6 +641,8 @@ SUBROUTINE BD_InputSolve( t, u, DvrData, ErrStat, ErrMsg) REAL(R8Ki) :: Orientation(3,3) REAL(R8Ki) :: wt ! time from start start of simulation multiplied by magnitude of rotational velocity REAL(R8Ki) :: swt, cwt ! sine and cosine of w*t + REAL(ReKi) :: LoadFreq + REAL(ReKi) :: LoadScale integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message @@ -681,16 +683,19 @@ SUBROUTINE BD_InputSolve( t, u, DvrData, ErrStat, ErrMsg) !............................. CALL Transfer_Point_to_Point( DvrData%mplLoads, u%PointLoad, DvrData%Map_mplLoads_to_PointLoad, ErrStat2, ErrMsg2, DvrData%mplMotion, DvrData%y_BldMotion_at_u_point) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + LoadFreq = 0.2 + LoadScale = cos(t*2.0_ReKi*PI*LoadFreq) - u%PointLoad%Force(1:3,u%PointLoad%NNodes) = u%PointLoad%Force(1:3,u%PointLoad%NNodes) + DvrData%TipLoad(1:3) - u%PointLoad%Moment(1:3,u%PointLoad%NNodes) = u%PointLoad%Moment(1:3,u%PointLoad%NNodes) + DvrData%TipLoad(4:6) + u%PointLoad%Force(1:3,u%PointLoad%NNodes) = u%PointLoad%Force(1:3,u%PointLoad%NNodes) + DvrData%TipLoad(1:3) * LoadScale + u%PointLoad%Moment(1:3,u%PointLoad%NNodes) = u%PointLoad%Moment(1:3,u%PointLoad%NNodes) + DvrData%TipLoad(4:6) * LoadScale !............................. ! LINE2 mesh: DistrLoad !............................. DO i=1,u%DistrLoad%NNodes - u%DistrLoad%Force(:,i) = DvrData%DistrLoad(1:3) - u%DistrLoad%Moment(:,i)= DvrData%DistrLoad(4:6) + u%DistrLoad%Force(:,i) = DvrData%DistrLoad(1:3) * LoadScale + u%DistrLoad%Moment(:,i)= DvrData%DistrLoad(4:6) * LoadScale ENDDO END SUBROUTINE BD_InputSolve diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 3404fb1a4e..fbe315a112 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -384,7 +384,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - integer(IntKi) :: i, j, flags + integer(IntKi) :: i, j, k, idx REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength TYPE(ModVarType) :: Var @@ -407,88 +407,88 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ! Add continuous state variables (translation and rotation) call MV_AddVar(p%Vars%x, 'PlatformSurge', VF_TransDisp, & - iUsr=[DOF_Sg], & + iUsr=DOF_Sg, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal surge translation DOF (internal DOF index = DOF_Sg), m'], & Active=InputFileData%PtfmSgDOF) call MV_AddVar(p%Vars%x, 'PlatformSway', VF_TransDisp, & - iUsr=[DOF_Sw], & + iUsr=DOF_Sw, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform horizontal sway translation DOF (internal DOF index = DOF_Sw), m'], & Active=InputFileData%PtfmSwDOF) call MV_AddVar(p%Vars%x, 'PlatformHeave', VF_TransDisp, & - iUsr=[DOF_Hv], & + iUsr=DOF_Hv, & Perturb=0.2_R8Ki * D2R_D * max(p%TowerHt, 1.0_ReKi), & LinNames=['Platform vertical heave translation DOF (internal DOF index = DOF_Hv), m'], & Active=InputFileData%PtfmHvDOF) call MV_AddVar(p%Vars%x, 'PlatformRoll', VF_AngularDisp, & - iUsr=[DOF_R], & + iUsr=DOF_R, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform roll tilt rotation DOF (internal DOF index = DOF_R), rad'], & Active=InputFileData%PtfmRDOF) call MV_AddVar(p%Vars%x, 'PlatformPitch', VF_AngularDisp, & - iUsr=[DOF_P], & + iUsr=DOF_P, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform pitch tilt rotation DOF (internal DOF index = DOF_P), rad'], & Active=InputFileData%PtfmPDOF) call MV_AddVar(p%Vars%x, 'PlatformYaw', VF_AngularDisp, & - iUsr=[DOF_Y], & + iUsr=DOF_Y, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Platform yaw rotation DOF (internal DOF index = DOF_Y), rad'], & Active=InputFileData%PtfmYDOF) call MV_AddVar(p%Vars%x, 'TowerFA1', VF_TransDisp, & - iUsr=[DOF_TFA1], & + iUsr=DOF_TFA1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower fore-aft bending mode DOF (internal DOF index = DOF_TFA1), m'], & Active=InputFileData%TwFADOF1) call MV_AddVar(p%Vars%x, 'TowerSS1', VF_TransDisp, & - iUsr=[DOF_TSS1], & + iUsr=DOF_TSS1, & Perturb=0.020_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['1st tower side-to-side bending mode DOF (internal DOF index = DOF_TSS1), m'], & Active=InputFileData%TwSSDOF1) call MV_AddVar(p%Vars%x, 'TowerFA2', VF_TransDisp, & - iUsr=[DOF_TFA2], & + iUsr=DOF_TFA2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower fore-aft bending mode DOF (internal DOF index = DOF_TFA2), m'], & Active=InputFileData%TwFADOF2) call MV_AddVar(p%Vars%x, 'TowerSS2', VF_TransDisp, & - iUsr=[DOF_TSS2], & + iUsr=DOF_TSS2, & Perturb=0.002_R8Ki * D2R_D * p%TwrFlexL, & LinNames=['2nd tower side-to-side bending mode DOF (internal DOF index = DOF_TSS2), m'], & Active=InputFileData%TwSSDOF2) call MV_AddVar(p%Vars%x, 'NacelleYaw', VF_AngularDisp, & - iUsr=[DOF_Yaw], & + iUsr=DOF_Yaw, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Nacelle yaw DOF (internal DOF index = DOF_Yaw), rad'], & Active=InputFileData%YawDOF) call MV_AddVar(p%Vars%x, 'RotorFurl', VF_AngularDisp, & - iUsr=[DOF_RFrl], & + iUsr=DOF_RFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Rotor-furl DOF (internal DOF index = DOF_RFrl), rad'], & Active=InputFileData%RFrlDOF) call MV_AddVar(p%Vars%x, 'GeneratorAzimuth', VF_AngularDisp, & - iUsr=[DOF_GeAz], & + iUsr=DOF_GeAz, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Variable speed generator DOF (internal DOF index = DOF_GeAz), rad'], & Active=InputFileData%GenDOF) call MV_AddVar(p%Vars%x, 'DrivetrainFlexibility', VF_AngularDisp, & - iUsr=[DOF_DrTr], & + iUsr=DOF_DrTr, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Drivetrain rotational-flexibility DOF (internal DOF index = DOF_DrTr), rad'], & Active=InputFileData%DrTrDOF) call MV_AddVar(p%Vars%x, 'TailFurl', VF_AngularDisp, & - iUsr=[DOF_TFrl], & + iUsr=DOF_TFrl, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Tail-furl DOF (internal DOF index = DOF_TFrl), rad'], & Active=InputFileData%TFrlDOF) call MV_AddVar(p%Vars%x, 'RotorTeeter', VF_AngularDisp, & - iUsr=[DOF_Teet], & + iUsr=DOF_Teet, & Perturb=2.0_R8Ki * D2R_D, & LinNames=['Hub teetering DOF (internal DOF index = DOF_Teet), rad'], & Active=InputFileData%TeetDOF) do i = 1, p%NumBl call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap1', VF_TransDisp, Flags=VF_RotFrame, & - iUsr=[DOF_BF(i,1)], & + iUsr=DOF_BF(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & LinNames=['1st flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',1)), m'], & @@ -496,7 +496,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, end do do i = 1, p%NumBl call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Edge1', VF_TransDisp, Flags=VF_RotFrame, & - iUsr=[DOF_BE(i,1)], & + iUsr=DOF_BE(i,1), & Perturb=0.20_R8Ki * D2R_D * p%BldFlexL, & LinNames=['1st edgewise bending-mode DOF of blade '//trim(Num2LStr(i))//& ' (internal DOF index = DOF_BE('//trim(Num2LStr(i))//',1)), m'], & @@ -504,7 +504,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, end do do i = 1, p%NumBl call MV_AddVar(p%Vars%x, 'Blade'//trim(Num2LStr(i))//'Flap2', VF_TransDisp, Flags=VF_RotFrame, & - iUsr=[DOF_BF(i,2)], & + iUsr=DOF_BF(i,2), & Perturb=0.02_R8Ki * D2R_D * p%BldFlexL, & LinNames=['2nd flapwise bending-mode DOF of blade '//trim(Num2LStr(i))//& ' (internal DOF index = DOF_BF('//trim(Num2LStr(i))//',2)), m'], & @@ -545,10 +545,11 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ! Blade Point Loads if (allocated(u%BladePtLoads)) then do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%u, "BladeLoad"//trim(Num2LStr(i)), LoadFields, & + call MV_AddMeshVar(p%Vars%u, "BladeLoad"//IdxStr(i), LoadFields, & Nodes=p%BldNodes, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & - MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) + MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)], & + Active=u%BladePtLoads(i)%committed) end do end if @@ -599,14 +600,14 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, if (allocated(y%BladeLn2Mesh))then do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'BladeMotion'//Num2LStr(i), MotionFields, Nodes=y%BladeLn2Mesh(i)%Nnodes, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'BladeMotion'//IdxStr(i), MotionFields, Nodes=y%BladeLn2Mesh(i)%Nnodes, Flags=VF_Line) end do end if call MV_AddMeshVar(p%Vars%y, 'PlatformMotion', MotionFields, Nodes=y%PlatformPtMesh%Nnodes) call MV_AddMeshVar(p%Vars%y, 'TowerMotion', MotionFields, Nodes=y%TowerLn2Mesh%Nnodes, Flags=VF_Line) call MV_AddMeshVar(p%Vars%y, 'HubMotion', [VF_TransDisp, VF_Orientation, VF_AngularVel], Nodes=y%HubPtMotion%Nnodes) do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'BladeRootMotion'//Num2LStr(i), MotionFields, Nodes=y%BladeRootMotion(i)%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'BladeRootMotion'//IdxStr(i), MotionFields, Nodes=y%BladeRootMotion(i)%Nnodes) end do call MV_AddMeshVar(p%Vars%y, 'NacelleMotion', MotionFields, Nodes=y%NacelleMotion%Nnodes) call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, LinNames=['Yaw, rad']) @@ -615,16 +616,20 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & Flags=OutParamFlags(p%OutParam(i)%Indx), & - iUsr=[i], & + iUsr=i, & LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=p%OutParam(i)%Indx > 0) end do - do i = 1, p%BldNd_TotNumOuts - call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & - Flags=VF_RotFrame, & - iUsr=[p%NumOuts+i], & - LinNames=[trim(p%BldNd_OutParam(i)%Name)//', '//trim(p%BldNd_OutParam(i)%Units)], & - Active=p%BldNd_OutParam(i)%Indx > 0) + idx = p%NumOuts + 1 + do i = 1, p%BldNd_NumOuts + do j = 1, p%BldNd_BladesOut + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, Num=p%BldNodes, & + Flags=VF_RotFrame, & + iUsr=idx, & + LinNames=[(BldOutLinName(p%BldNd_OutParam(i), j, k), k=1, p%BldNodes)], & + Active=p%BldNd_OutParam(i)%Indx > 0) + idx = idx + p%BldNodes + end do end do !---------------------------------------------------------------------------- @@ -678,6 +683,12 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, end do contains + function BldOutLinName(OutParam, iBlade, iNode) result(Name) + integer(IntKi), intent(in) :: iBlade, iNode + type(OutParmType), intent(in) :: OutParam + character(LinChanLen) :: Name + write(Name, '("B",I1.1,"N",I3.3,A,", ",A)') iBlade, iNode, trim(OutParam%Name), trim(OutParam%Units) + end function function OutParamFlags(indx) result(flags) integer(IntKi), intent(in) :: indx integer(IntKi) :: flags @@ -10602,6 +10613,9 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If extended linearization variable, skip if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle + ! TODO: Remove for linearization + if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -10642,6 +10656,9 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! If extended linearization variable, skip if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle + ! TODO: Remove for linearization + if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -10761,6 +10778,9 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! If extended linearization variable, skip if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle + ! TODO: Remove for linearization + if (iand(p%Vars%x(i)%Flags, VF_Solve) == 0) cycle + ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%x(i)%Num @@ -10798,6 +10818,9 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! If extended linearization variable, skip if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle + ! TODO: Remove for linearization + if (iand(p%Vars%x(i)%Flags, VF_Solve) == 0) cycle + ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%x(i)%Num @@ -11117,9 +11140,9 @@ subroutine ED_PackStateValues(p, x, ary) do i = 1, size(p%Vars%x) select case(p%Vars%x(i)%Field) case (VF_TransDisp, VF_AngularDisp) - ary(p%Vars%x(i)%iLoc) = x%QT(p%Vars%x(i)%iUsr) + ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr) case (VF_TransVel, VF_AngularVel) - ary(p%Vars%x(i)%iLoc) = x%QDT(p%Vars%x(i)%iUsr) + ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr) end select end do end subroutine @@ -11132,9 +11155,9 @@ subroutine ED_UnpackStateValues(p, ary, x) do i = 1, size(p%Vars%x) select case(p%Vars%x(i)%Field) case (VF_TransDisp, VF_AngularDisp) - x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc) + x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) case (VF_TransVel, VF_AngularVel) - x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc) + x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) end select end do end subroutine @@ -11184,7 +11207,7 @@ subroutine ED_PackOutputValues(p, y, ary) type(ED_ParameterType), intent(in) :: p type(ED_OutputType), intent(in) :: y real(R8Ki), intent(out) :: ary(:) - integer(IntKi) :: iv, i + integer(IntKi) :: iv, i, j iv = 1 if (allocated(y%BladeLn2Mesh)) then do i = 1, size(y%BladeLn2Mesh) @@ -11204,7 +11227,9 @@ subroutine ED_PackOutputValues(p, y, ary) call MV_PackVar(p%Vars%y, iv, y%YawRate, ary) call MV_PackVar(p%Vars%y, iv, y%HSS_Spd, ary) do while (iv <= size(p%Vars%y)) - call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr(1)), ary) + i = p%Vars%y(iv)%iUsr + j = i + p%Vars%y(iv)%Num - 1 + call MV_PackVar(p%Vars%y, iv, y%WriteOutput(i:j), ary) end do end subroutine diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index c0a9fc7858..3a6528326c 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -52,7 +52,7 @@ module ModVar public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_xyz, wm_from_xyz -public :: MV_FieldString +public :: MV_FieldString, IdxStr contains @@ -100,21 +100,21 @@ subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) ErrMsg = '' ! Initialize state variables - if (.not. allocated(Vars%x)) allocate(Vars%x(0)) + if (.not. allocated(Vars%x)) allocate (Vars%x(0)) StartIndex = 1 do i = 1, size(Vars%x) call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize input variables - if (.not. allocated(Vars%u)) allocate(Vars%u(0)) + if (.not. allocated(Vars%u)) allocate (Vars%u(0)) StartIndex = 1 do i = 1, size(Vars%u) call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return end do ! Initialize output variables - if (.not. allocated(Vars%y)) allocate(Vars%y(0)) + if (.not. allocated(Vars%y)) allocate (Vars%y(0)) StartIndex = 1 do i = 1, size(Vars%y) call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return @@ -525,6 +525,14 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & Ins=Instance, DT=ModDT, Vars=Vars) + ! Allocate source and destination mapping arrays + call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + !---------------------------------------------------------------------------- ! Calculate Module Substepping !---------------------------------------------------------------------------- @@ -587,11 +595,11 @@ subroutine MV_AddMeshVar(VarAry, Name, Fields, Nodes, Flags, Perturbs, Active) end do end subroutine -subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, Perturb, LinNames, Active) +subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, Perturb, LinNames, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field - integer(IntKi), optional, intent(in) :: Num, Flags, iUsr(:) + integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr real(R8Ki), optional, intent(in) :: Perturb logical, optional, intent(in) :: Active character(*), optional, intent(in) :: LinNames(:) @@ -610,6 +618,7 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, Perturb, LinNames, A if (present(Num)) Var%Num = Num if (present(Flags)) Var%Flags = Flags if (present(iUsr)) Var%iUsr = iUsr + if (present(jUsr)) Var%jUsr = jUsr if (present(Perturb)) Var%Perturb = Perturb if (present(LinNames)) then allocate (Var%LinNames(size(LinNames))) @@ -733,6 +742,23 @@ function string_equal_ci(s1, s2) result(is_equal) is_equal = .true. end function +function IdxStr(i1, i2, i3, i4, i5) result(s) + integer(IntKi), intent(in) :: i1 + integer(IntKi), optional, intent(in) :: i2, i3, i4, i5 + character(100) :: s + if (present(i5)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//','//trim(Num2LStr(i5))//')' + else if (present(i4)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//')' + else if (present(i3)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//')' + else if (present(i2)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//')' + else + s = '('//trim(Num2LStr(i1))//')' + end if +end function + !------------------------------------------------------------------------------- ! Rotation Utilities !------------------------------------------------------------------------------- @@ -821,9 +847,9 @@ pure function wm_to_dcm(c) result(R) real(R8Ki), intent(in) :: c(3) real(R8Ki) :: R(3, 3), c0, vc, ct(3, 3) integer(IntKi) :: i, j - ct(1,:) = [0.0_R8Ki, -c(3), c(2)] - ct(2,:) = [c(3), 0.0_R8Ki, -c(1)] - ct(3,:) = [-c(2), c(1), 0.0_R8Ki] + ct(1, :) = [0.0_R8Ki, -c(3), c(2)] + ct(2, :) = [c(3), 0.0_R8Ki, -c(1)] + ct(3, :) = [-c(2), c(1), 0.0_R8Ki] c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki vc = 2.0_R8Ki/(4.0_R8Ki - c0) R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki @@ -884,28 +910,28 @@ pure function wm_from_dcm(R) result(c) pure function wm_to_xyz(c) result(xyz) real(R8Ki), intent(in) :: c(3) real(R8Ki) :: phi, n(3), xyz(3), m - ! m = sqrt(dot_product(c,c)) - ! if (m == 0.0_R8Ki) then - ! xyz = 0.0_R8Ki - ! return - ! end if - ! n = c/m - ! phi = 4.0_R8Ki*atan(m/4.0_R8Ki) - ! xyz = phi*n - xyz = c + m = sqrt(dot_product(c,c)) + if (m == 0.0_R8Ki) then + xyz = 0.0_R8Ki + return + end if + n = c/m + phi = 4.0_R8Ki*atan(m/4.0_R8Ki) + xyz = phi*n + ! xyz = c end function pure function wm_from_xyz(xyz) result(c) real(R8Ki), intent(in) :: xyz(3) real(R8Ki) :: phi, n(3), c(3) - ! phi = sqrt(dot_product(xyz,xyz)) - ! if (phi == 0.0_R8Ki) then - ! c = 0.0_R8Ki - ! return - ! end if - ! n = xyz / phi - ! c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n - c = xyz + phi = sqrt(dot_product(xyz,xyz)) + if (phi == 0.0_R8Ki) then + c = 0.0_R8Ki + return + end if + n = xyz / phi + c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n + ! c = xyz end function ! pure function wm_from_dcm(R) result(c) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 2815058ba9..be5cd56627 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -116,11 +116,12 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: Num = 1 !< [-] INTEGER(IntKi) :: Flags = 0 !< [-] INTEGER(IntKi) :: DerivOrder = 0 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iUsr !< user defined indices for variable [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblSol !< indices in global solver arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iGblLin !< indices in global linearization arrays [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< q matrix row index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] + INTEGER(IntKi) :: iUsr = 0 !< first user defined index for variable [-] + INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] REAL(R8Ki) :: Perturb = 0 !< perturbation [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType @@ -168,6 +169,8 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] END TYPE ModDataType ! ======================= CONTAINS @@ -762,18 +765,6 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr DstModVarTypeData%Num = SrcModVarTypeData%Num DstModVarTypeData%Flags = SrcModVarTypeData%Flags DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder - if (allocated(SrcModVarTypeData%iUsr)) then - LB(1:1) = lbound(SrcModVarTypeData%iUsr) - UB(1:1) = ubound(SrcModVarTypeData%iUsr) - if (.not. allocated(DstModVarTypeData%iUsr)) then - allocate(DstModVarTypeData%iUsr(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iUsr.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr - end if if (allocated(SrcModVarTypeData%iLoc)) then LB(1:1) = lbound(SrcModVarTypeData%iLoc) UB(1:1) = ubound(SrcModVarTypeData%iLoc) @@ -786,29 +777,29 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr end if DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc end if - if (allocated(SrcModVarTypeData%iGblSol)) then - LB(1:1) = lbound(SrcModVarTypeData%iGblSol) - UB(1:1) = ubound(SrcModVarTypeData%iGblSol) - if (.not. allocated(DstModVarTypeData%iGblSol)) then - allocate(DstModVarTypeData%iGblSol(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModVarTypeData%iSol)) then + LB(1:1) = lbound(SrcModVarTypeData%iSol) + UB(1:1) = ubound(SrcModVarTypeData%iSol) + if (.not. allocated(DstModVarTypeData%iSol)) then + allocate(DstModVarTypeData%iSol(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iGblSol.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iSol.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModVarTypeData%iGblSol = SrcModVarTypeData%iGblSol + DstModVarTypeData%iSol = SrcModVarTypeData%iSol end if - if (allocated(SrcModVarTypeData%iGblLin)) then - LB(1:1) = lbound(SrcModVarTypeData%iGblLin) - UB(1:1) = ubound(SrcModVarTypeData%iGblLin) - if (.not. allocated(DstModVarTypeData%iGblLin)) then - allocate(DstModVarTypeData%iGblLin(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcModVarTypeData%iLin)) then + LB(1:1) = lbound(SrcModVarTypeData%iLin) + UB(1:1) = ubound(SrcModVarTypeData%iLin) + if (.not. allocated(DstModVarTypeData%iLin)) then + allocate(DstModVarTypeData%iLin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iGblLin.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLin.', ErrStat, ErrMsg, RoutineName) return end if end if - DstModVarTypeData%iGblLin = SrcModVarTypeData%iGblLin + DstModVarTypeData%iLin = SrcModVarTypeData%iLin end if if (allocated(SrcModVarTypeData%iq)) then LB(1:1) = lbound(SrcModVarTypeData%iq) @@ -822,6 +813,8 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr end if DstModVarTypeData%iq = SrcModVarTypeData%iq end if + DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr + DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb if (allocated(SrcModVarTypeData%LinNames)) then LB(1:1) = lbound(SrcModVarTypeData%LinNames) @@ -844,17 +837,14 @@ subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ModVarTypeData%iUsr)) then - deallocate(ModVarTypeData%iUsr) - end if if (allocated(ModVarTypeData%iLoc)) then deallocate(ModVarTypeData%iLoc) end if - if (allocated(ModVarTypeData%iGblSol)) then - deallocate(ModVarTypeData%iGblSol) + if (allocated(ModVarTypeData%iSol)) then + deallocate(ModVarTypeData%iSol) end if - if (allocated(ModVarTypeData%iGblLin)) then - deallocate(ModVarTypeData%iGblLin) + if (allocated(ModVarTypeData%iLin)) then + deallocate(ModVarTypeData%iLin) end if if (allocated(ModVarTypeData%iq)) then deallocate(ModVarTypeData%iq) @@ -875,31 +865,28 @@ subroutine NWTC_Library_PackModVarType(Buf, Indata) call RegPack(Buf, InData%Num) call RegPack(Buf, InData%Flags) call RegPack(Buf, InData%DerivOrder) - call RegPack(Buf, allocated(InData%iUsr)) - if (allocated(InData%iUsr)) then - call RegPackBounds(Buf, 1, lbound(InData%iUsr), ubound(InData%iUsr)) - call RegPack(Buf, InData%iUsr) - end if call RegPack(Buf, allocated(InData%iLoc)) if (allocated(InData%iLoc)) then call RegPackBounds(Buf, 1, lbound(InData%iLoc), ubound(InData%iLoc)) call RegPack(Buf, InData%iLoc) end if - call RegPack(Buf, allocated(InData%iGblSol)) - if (allocated(InData%iGblSol)) then - call RegPackBounds(Buf, 1, lbound(InData%iGblSol), ubound(InData%iGblSol)) - call RegPack(Buf, InData%iGblSol) + call RegPack(Buf, allocated(InData%iSol)) + if (allocated(InData%iSol)) then + call RegPackBounds(Buf, 1, lbound(InData%iSol), ubound(InData%iSol)) + call RegPack(Buf, InData%iSol) end if - call RegPack(Buf, allocated(InData%iGblLin)) - if (allocated(InData%iGblLin)) then - call RegPackBounds(Buf, 1, lbound(InData%iGblLin), ubound(InData%iGblLin)) - call RegPack(Buf, InData%iGblLin) + call RegPack(Buf, allocated(InData%iLin)) + if (allocated(InData%iLin)) then + call RegPackBounds(Buf, 1, lbound(InData%iLin), ubound(InData%iLin)) + call RegPack(Buf, InData%iLin) end if call RegPack(Buf, allocated(InData%iq)) if (allocated(InData%iq)) then call RegPackBounds(Buf, 1, lbound(InData%iq), ubound(InData%iq)) call RegPack(Buf, InData%iq) end if + call RegPack(Buf, InData%iUsr) + call RegPack(Buf, InData%jUsr) call RegPack(Buf, InData%Perturb) call RegPack(Buf, allocated(InData%LinNames)) if (allocated(InData%LinNames)) then @@ -929,20 +916,6 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DerivOrder) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%iUsr)) deallocate(OutData%iUsr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iUsr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iUsr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%iUsr) - if (RegCheckErr(Buf, RoutineName)) return - end if if (allocated(OutData%iLoc)) deallocate(OutData%iLoc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -957,32 +930,32 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) call RegUnpack(Buf, OutData%iLoc) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iGblSol)) deallocate(OutData%iGblSol) + if (allocated(OutData%iSol)) deallocate(OutData%iSol) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iGblSol(LB(1):UB(1)),stat=stat) + allocate(OutData%iSol(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iGblSol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iSol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iGblSol) + call RegUnpack(Buf, OutData%iSol) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iGblLin)) deallocate(OutData%iGblLin) + if (allocated(OutData%iLin)) deallocate(OutData%iLin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iGblLin(LB(1):UB(1)),stat=stat) + allocate(OutData%iLin(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iGblLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iGblLin) + call RegUnpack(Buf, OutData%iLin) if (RegCheckErr(Buf, RoutineName)) return end if if (allocated(OutData%iq)) deallocate(OutData%iq) @@ -999,6 +972,10 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) call RegUnpack(Buf, OutData%iq) if (RegCheckErr(Buf, RoutineName)) return end if + call RegUnpack(Buf, OutData%iUsr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%jUsr) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Perturb) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%LinNames)) deallocate(OutData%LinNames) @@ -1805,6 +1782,30 @@ subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, DstModDataTypeData%iys = SrcModDataTypeData%iys end if DstModDataTypeData%Vars => SrcModDataTypeData%Vars + if (allocated(SrcModDataTypeData%SrcMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%SrcMaps) + UB(1:1) = ubound(SrcModDataTypeData%SrcMaps) + if (.not. allocated(DstModDataTypeData%SrcMaps)) then + allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps + end if + if (allocated(SrcModDataTypeData%DstMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%DstMaps) + UB(1:1) = ubound(SrcModDataTypeData%DstMaps) + if (.not. allocated(DstModDataTypeData%DstMaps)) then + allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps + end if end subroutine subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) @@ -1826,6 +1827,12 @@ subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) deallocate(ModDataTypeData%iys) end if nullify(ModDataTypeData%Vars) + if (allocated(ModDataTypeData%SrcMaps)) then + deallocate(ModDataTypeData%SrcMaps) + end if + if (allocated(ModDataTypeData%DstMaps)) then + deallocate(ModDataTypeData%DstMaps) + end if end subroutine subroutine NWTC_Library_PackModDataType(Buf, Indata) @@ -1863,6 +1870,16 @@ subroutine NWTC_Library_PackModDataType(Buf, Indata) call NWTC_Library_PackModVarsType(Buf, InData%Vars) end if end if + call RegPack(Buf, allocated(InData%SrcMaps)) + if (allocated(InData%SrcMaps)) then + call RegPackBounds(Buf, 1, lbound(InData%SrcMaps), ubound(InData%SrcMaps)) + call RegPack(Buf, InData%SrcMaps) + end if + call RegPack(Buf, allocated(InData%DstMaps)) + if (allocated(InData%DstMaps)) then + call RegPackBounds(Buf, 1, lbound(InData%DstMaps), ubound(InData%DstMaps)) + call RegPack(Buf, InData%DstMaps) + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1952,6 +1969,34 @@ subroutine NWTC_Library_UnPackModDataType(Buf, OutData) else OutData%Vars => null() end if + if (allocated(OutData%SrcMaps)) deallocate(OutData%SrcMaps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SrcMaps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrcMaps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SrcMaps) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DstMaps)) deallocate(OutData%DstMaps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DstMaps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DstMaps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DstMaps) + if (RegCheckErr(Buf, RoutineName)) return + end if end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 85b3c57a10..68f7d70bb6 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -71,11 +71,12 @@ typedef ^ ^ IntKi Nodes - 1 - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iGblSol : - - "indices in global solver arrays" - -typedef ^ ^ IntKi iGblLin : - - "indices in global linearization arrays" - -typedef ^ ^ IntKi iq : - - "q matrix row index" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr - 0 - "first user defined index for variable" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - @@ -114,6 +115,8 @@ typedef ^ ^ IntKi ixs :: - - typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index d0b5cc9cd8..d562b48f6a 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -71,11 +71,12 @@ typedef ^ ^ IntKi Nodes - 1 - typedef ^ ^ IntKi Num - 1 - "" - typedef ^ ^ IntKi Flags - 0 - "" - typedef ^ ^ IntKi DerivOrder - 0 - "" - -typedef ^ ^ IntKi iUsr : - - "user defined indices for variable" - typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - -typedef ^ ^ IntKi iGblSol : - - "indices in global solver arrays" - -typedef ^ ^ IntKi iGblLin : - - "indices in global linearization arrays" - -typedef ^ ^ IntKi iq : - - "q matrix row index" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr - 0 - "first user defined index for variable" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - @@ -114,3 +115,5 @@ typedef ^ ^ IntKi ixs :: - - typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index ff13af5a56..4a0d1b279e 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -163,8 +163,8 @@ logical function Failed() end function end subroutine -subroutine FAST_InitIO(ModData, this_time, DT, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData !< Module data +subroutine FAST_InitIO(Mods, this_time, DT, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data real(DbKi), intent(in) :: this_time !< Initial simulation time (almost always 0) real(DbKi), intent(in) :: DT !< Glue code time step size type(FAST_TurbineType), intent(inout) :: T !< Turbine type @@ -175,88 +175,92 @@ subroutine FAST_InitIO(ModData, this_time, DT, T, ErrStat, ErrMsg) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 real(DbKi) :: t_global_next ! Simulation time for computing outputs - integer(IntKi) :: j, k + integer(IntKi) :: i, j, k ErrStat = ErrID_None ErrMsg = '' - ! Copy state from current to predicted and initialze meshes - call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Loop through modules + do i = 1, size(Mods) - ! Select based on module ID - select case (ModData%ID) + ! Copy state from current to predicted and initialze meshes + call FAST_CopyStates(Mods(i), T, STATE_CURR, STATE_PRED, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - case (Module_AD) + ! Select based on module ID + select case (Mods(i)%ID) - T%AD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call AD_CopyInput(T%AD%Input(1), T%AD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call AD_CopyInput(T%AD%Input(1), T%AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + case (Module_AD) - case (Module_BD) + T%AD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call AD_CopyInput(T%AD%Input(1), T%AD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call AD_CopyInput(T%AD%Input(1), T%AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - T%BD%InputTimes(:, ModData%Ins) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call BD_CopyInput(T%BD%Input(1, ModData%Ins), T%BD%Input(k, ModData%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call BD_CopyInput(T%BD%Input(1, ModData%Ins), T%BD%u(ModData%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + case (Module_BD) - case (Module_ED) + T%BD%InputTimes(:, Mods(i)%Ins) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call BD_CopyInput(T%BD%Input(1, Mods(i)%Ins), T%BD%Input(k, Mods(i)%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call BD_CopyInput(T%BD%Input(1, Mods(i)%Ins), T%BD%u(Mods(i)%Ins), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - T%ED%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call ED_CopyInput(T%ED%Input(1), T%ED%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + case (Module_ED) + + T%ED%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call ED_CopyInput(T%ED%Input(1), T%ED%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ED_CopyInput(T%ED%Input(1), T%ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return ! case (Module_ExtPtfm) ! case (Module_FEAM) - case (Module_HD) + case (Module_HD) - T%HD%InputTimes(:) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call HydroDyn_CopyInput(T%HD%Input(1), T%HD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call HydroDyn_CopyInput(T%HD%Input(1), T%HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + T%HD%InputTimes(:) = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call HydroDyn_CopyInput(T%HD%Input(1), T%HD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call HydroDyn_CopyInput(T%HD%Input(1), T%HD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return ! case (Module_IceD) ! case (Module_IceF) - case (Module_IfW) + case (Module_IfW) - ! TODO: Fix inconsistent function name - T%IfW%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + ! TODO: Fix inconsistent function name + T%IfW%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call InflowWind_CopyInput(T%IfW%Input(1), T%IfW%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return ! case (Module_MAP) ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) - case (Module_SD) + case (Module_SD) - T%SD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call SD_CopyInput(T%SD%Input(1), T%SD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call SD_CopyInput(T%SD%Input(1), T%SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + T%SD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call SD_CopyInput(T%SD%Input(1), T%SD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call SD_CopyInput(T%SD%Input(1), T%SD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return ! case (Module_SeaSt) - case (Module_SrvD) + case (Module_SrvD) - T%SrvD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] - do k = 2, T%p_FAST%InterpOrder + 1 - call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - end do - call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + T%SrvD%InputTimes = this_time - DT*[(k, k=0, T%p_FAST%InterpOrder)] + do k = 2, T%p_FAST%InterpOrder + 1 + call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%Input(k), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call SrvD_CopyInput(T%SrvD%Input(1), T%SrvD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - case default - call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) - return - end select + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(Mods(i)%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + end do contains logical function Failed() @@ -389,7 +393,7 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_InitMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i + integer(IntKi) :: i, j, k integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst ErrStat = ErrID_None @@ -412,28 +416,90 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) do iModDst = 1, size(Mods) associate (ModSrc => Mods(iModSrc), ModDst => Mods(iModDst)) + ! Switch by destination module select case (ModDst%ID) - case (Module_BD) ! BeamDyn Input ---------------------------------- + case (Module_AD) !-------------------------------------------------- + + select case (ModSrc%ID) + case (Module_ED) + + call MapMotionMesh(Key='ED TowerMotion -> AD TowerMotion', & + SrcMod=ModSrc, SrcMeshName='TowerMotion', & + DstMod=ModDst, DstMeshName='TowerMotion', & + Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) + + call MapMotionMesh(Key='ED HubMotion -> AD HubMotion', & + SrcMod=ModSrc, SrcMeshName='HubMotion', & + DstMod=ModDst, DstMeshName='HubMotion') + + call MapMotionMesh(Key='ED NacelleMotion -> AD NacelleMotion', & + SrcMod=ModSrc, SrcMeshName='NacelleMotion', & + DstMod=ModDst, DstMeshName='NacelleMotion', & + Active=T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) + + call MapMotionMesh(Key='ED TFinMotion -> AD TFinMotion', & + SrcMod=ModSrc, SrcMeshName='TFinMotion', & + DstMod=ModDst, DstMeshName='TFinMotion', & + Active=T%AD%Input(1)%rotors(1)%TFinMotion%Committed) + + do i = 1, size(T%ED%y%BladeRootMotion) + call MapMotionMesh(Key='ED BladeRootMotion -> AD BladeRootMotion', i1=i, & + SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//IdxStr(i), & + DstMod=ModDst, DstMeshName='BladeRootMotion'//IdxStr(i)) + end do + + if (T%p_FAST%CompElast == Module_ED) then + do i = 1, size(T%ED%y%BladeLn2Mesh) + call MapMotionMesh(Key='ED BladeMotion -> AD BladeMotion', i1=i, & + SrcMod=ModSrc, SrcMeshName='BladeMotion'//IdxStr(i), & + DstMod=ModDst, DstMeshName='BladeMotion'//IdxStr(i)) + end do + end if + + case (Module_BD) + + call MapMotionMesh(Key='BD BladeMotion -> AD BladeMotion', & + SrcMod=ModSrc, SrcMeshName='BladeMotion', & + DstMod=ModDst, DstMeshName='BladeMotion'//IdxStr(ModSrc%Ins)) + + case (Module_SrvD) + + call MapNonMesh(Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=ModSrc, DstMod=ModDst) + + end select + + case (Module_BD) !-------------------------------------------------- select case (ModSrc%ID) case (Module_ED) call MapMotionMesh(Key='ED BladeRoot -> BD RootMotion', & - SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//trim(Num2LStr(ModDst%Ins)), & + SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//IdxStr(ModDst%Ins), & DstMod=ModDst, DstMeshName='RootMotion') case (Module_AD) - call MapLoadMesh(Key='AD BladeLoad -> BD BladeLoad', & - SrcMod=ModSrc, SrcMeshName='BladeLoad'//Num2LStr(ModDst%Ins), SrcDispMeshName='BladeMotion'//Num2LStr(i), & + call MapLoadMesh(Key='AD BladeLoad -> BD DistrLoad', & + SrcMod=ModSrc, SrcMeshName='R1BladeLoad'//IdxStr(ModDst%Ins), SrcDispMeshName='R1BladeMotion'//IdxStr(ModDst%Ins), & DstMod=ModDst, DstMeshName='DistrLoad', DstDispMeshName='BladeMotion') case (Module_SrvD) + ! if (allocated(T%SrvD%y%BStCLoadMesh)) then + ! do j = 1, size(T%SrvD%y%BStCLoadMesh, 2) + ! call MapLoadMesh(Key='SrvD BStCLoadMesh -> BD DistrLoad', i1=j, & + ! SrcMod=ModSrc, & + ! SrcMeshName='BStCLoadMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & + ! SrcDispMeshName='BStCMotionMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & + ! DstMod=ModDst, DstMeshName='DistrLoad', DstDispMeshName='BladeMotion', & + ! Active=T%SrvD%y%BStCLoadMesh(ModDst%Ins, j)%Committed) + ! end do + ! end if + end select - case (Module_ED) ! ElastoDyn Input -------------------------------- + case (Module_ED) !-------------------------------------------------- select case (ModSrc%ID) case (Module_BD) @@ -445,83 +511,70 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) case (Module_AD) if (T%p_FAST%CompElast == Module_ED) then - do i = 1, size(T%ED%Input(1)%BladePtLoads, 1) - call MapLoadMesh(Key='AD BladeLoad -> ED BladeLoad', Idx=i, & - SrcMod=ModSrc, SrcMeshName='BladeLoad'//Num2LStr(i), SrcDispMeshName='BladeMotion'//Num2LStr(i), & - DstMod=ModDst, DstMeshName='BladeLoad'//Num2LStr(i), DstDispMeshName='BladeMotion'//Num2LStr(i)) + do i = 1, size(T%ED%Input(1)%BladePtLoads) + call MapLoadMesh(Key='AD BladeLoad -> ED BladeLoad', i1=i, & + SrcMod=ModSrc, SrcMeshName='R1BladeLoad'//IdxStr(i), SrcDispMeshName='R1BladeMotion'//IdxStr(i), & + DstMod=ModDst, DstMeshName='BladeLoad'//IdxStr(i), DstDispMeshName='BladeMotion'//IdxStr(i)) end do end if call MapLoadMesh(Key='AD TowerLoad -> ED TowerLoad', & - SrcMod=ModSrc, SrcMeshName='TowerLoad', SrcDispMeshName='TowerMotion', & + SrcMod=ModSrc, SrcMeshName='R1TowerLoad', SrcDispMeshName='R1TowerMotion', & DstMod=ModDst, DstMeshName='TowerLoad', DstDispMeshName='TowerMotion', & Active=T%AD%y%rotors(1)%TowerLoad%committed) call MapLoadMesh(Key='AD NacelleLoad -> ED NacelleLoad', & - SrcMod=ModSrc, SrcMeshName='NacelleLoad', SrcDispMeshName='NacelleMotion', & + SrcMod=ModSrc, SrcMeshName='R1NacelleLoad', SrcDispMeshName='R1NacelleMotion', & DstMod=ModDst, DstMeshName='NacelleLoad', DstDispMeshName='NacelleMotion', & Active=T%AD%Input(1)%rotors(1)%NacelleMotion%committed) - call MapLoadMesh(Key='AD HubLoad -> ED HubLoad', & - SrcMod=ModSrc, SrcMeshName='HubLoad', SrcDispMeshName='HubMotion', & - DstMod=ModDst, DstMeshName='HubLoad', DstDispMeshName='HubMotion', & - Active=T%AD%Input(1)%rotors(1)%HubMotion%committed) + ! call MapLoadMesh(Key='AD HubLoad -> ED HubLoad', & + ! SrcMod=ModSrc, SrcMeshName='R1HubLoad', SrcDispMeshName='R1HubMotion', & + ! DstMod=ModDst, DstMeshName='HubLoad', DstDispMeshName='HubMotion', & + ! Active=T%AD%Input(1)%rotors(1)%HubMotion%committed) call MapLoadMesh(Key='AD TFinLoad -> ED TFinLoad', & - SrcMod=ModSrc, SrcMeshName='TFinLoad', SrcDispMeshName='TFinMotion', & + SrcMod=ModSrc, SrcMeshName='R1TFinLoad', SrcDispMeshName='R1TFinMotion', & DstMod=ModDst, DstMeshName='TFinLoad', DstDispMeshName='TFinMotion', & Active=T%AD%Input(1)%rotors(1)%TFinMotion%committed) case (Module_SrvD) + call MapNonMesh("SrvD Data -> ED Data", SrcMod=ModSrc, DstMod=ModDst) + + ! if ((T%p_FAST%CompElast == Module_ED) .and. allocated(T%SrvD%y%BStCLoadMesh)) then + ! do j = 1, size(T%SrvD%y%BStCLoadMesh, 2) + ! call MapLoadMesh(Key='SrvD BStCLoadMesh -> ED BladeLoad', i1=j, & + ! SrcMod=ModSrc, & + ! SrcMeshName='BStCLoadMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & + ! SrcDispMeshName='BStCMotionMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & + ! DstMod=ModDst, DstMeshName='BladeLoad'//Num2LStr(i), DstDispMeshName='BladeMotion', & + ! Active=T%SrvD%y%BStCLoadMesh(ModDst%Ins, j)%Committed) + ! end do + ! end if + end select - case (Module_AD) ! AeroDyn Input ---------------------------------- + case (Module_IfW) !------------------------------------------------- select case (ModSrc%ID) case (Module_ED) + call MapNonMesh("ED HubMotion -> IfW HubMotion", SrcMod=ModSrc, DstMod=ModDst) + end select - call MapMotionMesh(Key='ED TowerMotion -> AD TowerMotion', & - SrcMod=ModSrc, SrcMeshName='TowerMotion', & - DstMod=ModDst, DstMeshName='TowerMotion', & - Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) - - call MapMotionMesh(Key='ED HubMotion -> AD HubMotion', & - SrcMod=ModSrc, SrcMeshName='HubMotion', & - DstMod=ModDst, DstMeshName='HubMotion') - - call MapMotionMesh(Key='ED NacelleMotion -> AD NacelleMotion', & - SrcMod=ModSrc, SrcMeshName='NacelleMotion', & - DstMod=ModDst, DstMeshName='NacelleMotion', & - Active=T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) - - call MapMotionMesh(Key='ED TFinMotion -> AD TFinMotion', & - SrcMod=ModSrc, SrcMeshName='TFinMotion', & - DstMod=ModDst, DstMeshName='TFinMotion', & - Active=T%AD%Input(1)%rotors(1)%TFinMotion%Committed) - - do i = 1, size(T%ED%y%BladeRootMotion) - call MapMotionMesh(Key='ED BladeRootMotion -> AD BladeRootMotion', Idx=i, & - SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//Num2LStr(i), & - DstMod=ModDst, DstMeshName='BladeRootMotion'//Num2LStr(i)) - end do + case (Module_SrvD) !------------------------------------------------ + select case (ModSrc%ID) + case (Module_BD) + call MapNonMesh("BD Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) + call MapNonMesh("BD RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) + case (Module_ED) + call MapNonMesh("ED Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) if (T%p_FAST%CompElast == Module_ED) then - do i = 1, size(T%ED%y%BladeLn2Mesh) - call MapMotionMesh(Key='ED BladeMotion -> AD BladeMotion', Idx=i, & - SrcMod=ModSrc, SrcMeshName='BladeMotion'//Num2LStr(i), & - DstMod=ModDst, DstMeshName='BladeMotion'//Num2LStr(i)) - end do + call MapNonMesh("ED RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) end if - - case (Module_BD) - - call MapMotionMesh(Key='BD BladeMotion -> AD BladeMotion', & - SrcMod=ModSrc, SrcMeshName='BladeMotion', & - DstMod=ModDst, DstMeshName='BladeMotion'//Num2LStr(i)) - - case (Module_SrvD) - + case (Module_IfW) + call MapNonMesh("IfW Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) end select end select @@ -533,18 +586,19 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Get module indices in ModData and determine which mappings are active !---------------------------------------------------------------------------- - ! Loop through Maps + ! Loop through mappings do iMap = 1, size(Maps) - associate (Map => Maps(iMap), & SrcMod => Mods(Maps(iMap)%SrcModIdx), & DstMod => Mods(Maps(iMap)%DstModIdx)) - ! If source and destination modules are not part of the tight coupling, cycle - ! if (.not. (SrcMod%IsTC .and. DstMod%IsTC)) cycle + ! Add mapping index to sorce and destination module mapping arrays + SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] + DstMod%DstMaps = [DstMod%DstMaps, iMap] - ! If load mapping - if (Map%IsLoad) then + ! Switch based on mapping type + select case (Map%Typ) + case (Map_LoadMesh) ! Source mesh variable indices Map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, Map%SrcMeshName, LoadFields(i)), i=1, size(LoadFields))] @@ -560,11 +614,43 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Destination displacement mesh is in output of destination module (only translation displacement needed) Map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, Map%DstDispMeshName, VF_TransDisp) + ! If source mesh not found, return with error + if (size(Map%SrcVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'No load fields found for src mesh '//trim(Map%SrcMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) + return + end if + + ! If source displacement mesh not found, return with error + if (Map%SrcDispVarIdx == 0) then + call SetErrStat(ErrID_Fatal, 'No TransDisp field found for src mesh '//trim(Map%SrcDispMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) + return + end if + + ! If destination mesh not found, return with error + if (size(Map%SrcVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'No load fields found for dst mesh '//trim(Map%DstMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) + return + end if + + ! If source displacement mesh not found, return with error + if (Map%DstDispVarIdx == 0) then + call SetErrStat(ErrID_Fatal, 'No TransDisp field found for dst mesh '//trim(Map%DstDispMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) + return + end if + + ! Mark variables with Solve flag + do i = 1, size(map%SrcVarIdx) + call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(i)), VF_Solve) + end do + do i = 1, size(map%DstVarIdx) + call SetFlags(DstMod%Vars%u(map%DstVarIdx(i)), VF_Solve) + end do + ! Mark displacement variables with Solve flag if (Map%SrcDispVarIdx > 0) call SetFlags(SrcMod%Vars%u(Map%SrcDispVarIdx), VF_Solve) if (Map%DstDispVarIdx > 0) call SetFlags(DstMod%Vars%y(Map%DstDispVarIdx), VF_Solve) - else + case (Map_MotionMesh) ! Source mesh motion field variables map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(i)), i=1, size(MotionFields))] @@ -574,15 +660,35 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(i)), i=1, size(MotionFields))] map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) - end if - - ! Mark variables with Solve flag - do i = 1, size(map%SrcVarIdx) - call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(i)), VF_Solve) - end do - do i = 1, size(map%DstVarIdx) - call SetFlags(DstMod%Vars%u(map%DstVarIdx(i)), VF_Solve) - end do + ! If source mesh not found, return with error + if (size(Map%SrcVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'No load fields found for src mesh '//trim(Map%SrcMeshName)//' in mapping '//trim(Map%Key), & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! If destination mesh not found, return with error + if (size(Map%SrcVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'No load fields found for dst mesh '//trim(Map%DstMeshName)//' in mapping '//trim(Map%Key), & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Mark variables with Solve flag + do i = 1, size(map%SrcVarIdx) + call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(i)), VF_Solve) + end do + do i = 1, size(map%DstVarIdx) + call SetFlags(DstMod%Vars%u(map%DstVarIdx(i)), VF_Solve) + end do + + case (Map_NonMesh) + ! Nothing to do for non-mesh mapping + + case default + call SetErrStat(ErrID_Fatal, "Invalid mapping type: "//trim(Num2LStr(Map%Typ)), ErrStat, ErrMsg, RoutineName) + return + end select end associate @@ -598,12 +704,55 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Select by mapping key select case (Maps(i)%Key) - case ('AD BladeLoad -> BD BladeLoad') + !---------------------------------------------------------------------- + ! AeroDyn Inputs + !---------------------------------------------------------------------- + + case ('BD BladeMotion -> AD BladeMotion') + call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%BldMotion, T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED BladeMotion -> AD BladeMotion') + call MeshMapCreate(T%ED%y%BladeLn2Mesh(Maps(i)%i1), T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%i1), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED BladeRootMotion -> AD BladeRootMotion') + call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%i1), T%AD%Input(1)%rotors(1)%BladeRootMotion(Maps(i)%i1), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED HubMotion -> AD HubMotion') + call MeshMapCreate(T%ED%y%HubPtMotion, T%AD%Input(1)%rotors(1)%HubMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED NacelleMotion -> AD NacelleMotion') + call MeshMapCreate(T%ED%y%NacelleMotion, T%AD%Input(1)%rotors(1)%NacelleMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED TFinMotion -> AD TFinMotion') + call MeshMapCreate(T%ED%y%TFinCMMotion, T%AD%Input(1)%rotors(1)%TFinMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED TowerMotion -> AD TowerMotion') + call MeshMapCreate(T%ED%y%TowerLn2Mesh, T%AD%Input(1)%rotors(1)%TowerMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('SrvD BlAirfoilCom -> AD UserProp') + + !---------------------------------------------------------------------- + ! BeamDyn Inputs + !---------------------------------------------------------------------- + + case ('AD BladeLoad -> BD DistrLoad') call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('ED BladeRoot -> BD RootMotion') + call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + + case ('SrvD BStCLoadMesh -> BD DistrLoad') + call MeshMapCreate(T%SrvD%y%BStCLoadMesh(Maps(i)%DstIns, Maps(i)%i1), T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + + !---------------------------------------------------------------------- + ! ElastoDyn Inputs + !---------------------------------------------------------------------- case ('AD BladeLoad -> ED BladeLoad') - call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%Idx), T%ED%Input(1)%BladePtLoads(Maps(i)%Idx), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - ! call MeshCopy(T%ED%Input(1)%BladePtLoads(Maps(i)%Idx), Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%i1), T%ED%Input(1)%BladePtLoads(Maps(i)%i1), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + call MeshCopy(T%ED%Input(1)%BladePtLoads(Maps(i)%i1), Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return case ('AD NacelleLoad -> ED NacelleLoad') call MeshMapCreate(T%AD%y%rotors(1)%NacelleLoad, T%ED%Input(1)%NacelleLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return @@ -620,78 +769,97 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) call MeshMapCreate(T%AD%y%rotors(1)%TowerLoad, T%ED%Input(1)%TowerPtLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return call MeshCopy(T%ED%Input(1)%TowerPtLoads, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return - case ('BD BladeMotion -> AD BladeMotion') - call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%BldMotion, T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - case ('BD ReactionForce -> ED HubLoad') call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%ReactionForce, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return - case ('ED BladeMotion -> AD BladeMotion') - call MeshMapCreate(T%ED%y%BladeLn2Mesh(Maps(i)%Idx), T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%Idx), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + case ("SrvD Data -> ED Data") - case ('ED BladeRoot -> BD RootMotion') - call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + !---------------------------------------------------------------------- + ! InflowWind Inputs + !---------------------------------------------------------------------- - case ('ED BladeRootMotion -> AD BladeRootMotion') - call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%Idx), T%AD%Input(1)%rotors(1)%BladeRootMotion(Maps(i)%Idx), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + case ('ED HubMotion -> IfW HubMotion') - case ('ED HubMotion -> AD HubMotion') - call MeshMapCreate(T%ED%y%HubPtMotion, T%AD%Input(1)%rotors(1)%HubMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + !---------------------------------------------------------------------- + ! ServoDyn Inputs + !---------------------------------------------------------------------- - case ('ED NacelleMotion -> AD NacelleMotion') - call MeshMapCreate(T%ED%y%NacelleMotion, T%AD%Input(1)%rotors(1)%NacelleMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + case ("BD Data -> SrvD Data") + case ("BD RootM -> SrvD RootM") - case ('ED TFinMotion -> AD TFinMotion') - call MeshMapCreate(T%ED%y%TFinCMMotion, T%AD%Input(1)%rotors(1)%TFinMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + case ("ED Data -> SrvD Data") + case ("ED RootM -> SrvD RootM") - case ('ED TowerMotion -> AD TowerMotion') - call MeshMapCreate(T%ED%y%TowerLn2Mesh, T%AD%Input(1)%rotors(1)%TowerMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + case ("IfW Data -> SrvD Data") case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) return end select + + ! Reset remap flags in mapping temporary meshe + if (associated(Maps(i)%MeshTmp%RemapFlag)) Maps(i)%MeshTmp%RemapFlag = .false. end do contains subroutine MapLoadMesh(Key, SrcMod, SrcMeshName, SrcDispMeshName, & - DstMod, DstMeshName, DstDispMeshName, Idx, Active) + DstMod, DstMeshName, DstDispMeshName, i1, i2, Active) character(*), intent(in) :: Key type(ModDataType), intent(in) :: SrcMod, DstMod character(*), intent(in) :: SrcMeshName, DstMeshName character(*), intent(in) :: SrcDispMeshName, DstDispMeshName - integer(IntKi), optional, intent(in) :: Idx + integer(IntKi), optional, intent(in) :: i1, i2 logical, optional, intent(in) :: Active - integer(IntKi) :: LocIdx + integer(IntKi) :: i1Loc, i2Loc if (present(Active)) then if (.not. Active) return end if - LocIdx = 0 - if (present(Idx)) LocIdx = Idx - Maps = [Maps, TC_MappingType(Key=Key, isLoad=.true., & + i1Loc = 0 + i2Loc = 0 + if (present(i1)) i1Loc = i1 + if (present(i2)) i2Loc = i2 + Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_LoadMesh, i1=i1Loc, i2=i2Loc, & SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName, & - Idx=LocIdx)] + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] end subroutine subroutine MapMotionMesh(Key, SrcMod, SrcMeshName, & - DstMod, DstMeshName, Idx, Active) + DstMod, DstMeshName, i1, i2, Active) character(*), intent(in) :: Key type(ModDataType), intent(in) :: SrcMod, DstMod character(*), intent(in) :: SrcMeshName, DstMeshName - integer(IntKi), optional, intent(in) :: Idx + integer(IntKi), optional, intent(in) :: i1, i2 logical, optional, intent(in) :: Active - integer(IntKi) :: LocIdx + integer(IntKi) :: i1Loc, i2Loc if (present(Active)) then if (.not. Active) return end if - LocIdx = 0 - if (present(Idx)) LocIdx = Idx - Maps = [Maps, TC_MappingType(Key=Key, isLoad=.false., & + i1Loc = 0 + i2Loc = 0 + if (present(i1)) i1Loc = i1 + if (present(i2)) i2Loc = i2 + Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_MotionMesh, i1=i1Loc, i2=i2Loc, & SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshName=SrcMeshName, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName, & - Idx=LocIdx)] + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName)] + end subroutine + + subroutine MapNonMesh(Key, SrcMod, DstMod, i1, i2, Active) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + integer(IntKi), optional, intent(in) :: i1, i2 + logical, optional, intent(in) :: Active + integer(IntKi) :: i1Loc, i2Loc + if (present(Active)) then + if (.not. Active) return + end if + i1Loc = 0 + i2Loc = 0 + if (present(i1)) i1Loc = i1 + if (present(i2)) i2Loc = i2 + Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_NonMesh, i1=i1Loc, i2=i2Loc, & + SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, & + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins)] end subroutine logical function Failed() @@ -753,81 +921,42 @@ subroutine FAST_InputSolve(ModData, Maps, Dst, T, ErrStat, ErrMsg) else call IfW_InputSolve1(ModData, Maps, T%IfW%u, T, ErrStat2, ErrMsg2) end if + case (Module_SrvD) + if (Dst == IS_Input) then + call SrvD_InputSolve1(ModData, Maps, T%SrvD%Input(1), T, ErrStat2, ErrMsg2) + else + call SrvD_InputSolve1(ModData, Maps, T%SrvD%u, T, ErrStat2, ErrMsg2) + end if + case default + call SetErrStat(ErrID_Fatal, 'Unknown Module "'//trim(ModData%Abbr)//'", ID='//Num2LStr(ModData%ID), & + ErrStat, ErrMsg, RoutineName) + return end select call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine BD_InputSolve1(ModData, Maps, u_BD, T, ErrStat, ErrMsg) - type(BD_InputType), intent(inout) :: u_BD - type(ModDataType), intent(in) :: ModData !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = 'BD_InputSolve' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i - - ErrStat = ErrID_None - ErrMsg = '' - - ! Loop through mappings that set this module's inputs - do i = 1, size(Maps) - - ! If this is not the destination module, cycle - if (ModData%Idx /= Maps(i)%DstModIdx) cycle - - ! If mapping source has not been calculated, cycle - if (.not. Maps(i)%Ready) cycle - - select case (Maps(i)%Key) - case ('AD BladeLoad -> BD BladeLoad') - call Transfer_Line2_to_Line2(T%AD%y%rotors(1)%BladeLoad(Maps(i)%DstIns), & - u_BD%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2, & - T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), & - T%BD%y(Maps(i)%DstIns)%BldMotion) - - case ('ED BladeRoot -> BD RootMotion') - call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%DstIns), & - u_BD%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2) - - case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) - return - end select - - ! Check for transfer errors and return if failed - if (ErrStat2 >= AbortErrLev) then - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) - return - end if - end do -end subroutine - subroutine AD_InputSolve1(ModData, Maps, u_AD, T, ErrStat, ErrMsg) - type(AD_InputType), intent(inout) :: u_AD - type(ModDataType), intent(in) :: ModData !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg + type(AD_InputType), intent(inout) :: u_AD + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg character(*), parameter :: RoutineName = 'AD_InputSolve' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i + integer(IntKi) :: i, j, k_bl, k_bn ErrStat = ErrID_None ErrMsg = '' - ! Loop through mappings that set this module's inputs - do i = 1, size(Maps) + ! Loop through mappings where this module is the destination + do j = 1, size(ModData%DstMaps) - ! If this is not the destination module, cycle - if (ModData%Idx /= Maps(i)%DstModIdx) cycle + ! Get mapping index + i = ModData%DstMaps(j) ! If mapping source has not been calculated, cycle if (.not. Maps(i)%Ready) cycle @@ -837,172 +966,430 @@ subroutine AD_InputSolve1(ModData, Maps, u_AD, T, ErrStat, ErrMsg) call Transfer_Line2_to_Line2(T%BD%y(Maps(i)%SrcIns)%BldMotion, & u_AD%rotors(1)%BladeMotion(Maps(i)%SrcIns), & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('ED BladeMotion -> AD BladeMotion') - call Transfer_Line2_to_Line2(T%ED%y%BladeLn2Mesh(Maps(i)%Idx), & - u_AD%rotors(1)%BladeMotion(Maps(i)%Idx), & + call Transfer_Line2_to_Line2(T%ED%y%BladeLn2Mesh(Maps(i)%i1), & + u_AD%rotors(1)%BladeMotion(Maps(i)%i1), & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('ED BladeRootMotion -> AD BladeRootMotion') - call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%Idx), & - u_AD%rotors(1)%BladeRootMotion(Maps(i)%Idx), & + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%i1), & + u_AD%rotors(1)%BladeRootMotion(Maps(i)%i1), & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('ED HubMotion -> AD HubMotion') call Transfer_Point_to_Point(T%ED%y%HubPtMotion, & u_AD%rotors(1)%HubMotion, & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('ED NacelleMotion -> AD NacelleMotion') call Transfer_Point_to_Point(T%ED%y%NacelleMotion, & u_AD%rotors(1)%NacelleMotion, & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('ED TFinMotion -> AD TFinMotion') call Transfer_Point_to_Point(T%ED%y%TFinCMMotion, & u_AD%rotors(1)%TFinMotion, & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('ED TowerMotion -> AD TowerMotion') call Transfer_Line2_to_Line2(T%ED%y%TowerLn2Mesh, & u_AD%rotors(1)%TowerMotion, & Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + case ('SrvD BlAirfoilCom -> AD UserProp') + ! Set Conrol parameter (i.e. flaps) if using ServoDyn bem: + ! This takes in flap deflection for each blade (only one flap deflection angle per blade), + ! from ServoDyn (which comes from Bladed style DLL controller) + ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) + ! This is passed to AD15 to be interpolated with the airfoil table userprop column + ! (might be used for airfoil flap angles for example) + ! Must be same units as given in airfoil (no unit conversions handled in code)ß + ! do k_bl = 1, size(u_AD%rotors(1)%UserProp, dim=2) + ! do k_bn = 1, size(u_AD%rotors(1)%UserProp, dim=1) + ! u_AD%rotors(1)%UserProp(k_bn, k_bl) = T%SrvD%y%BlAirfoilCom(k_bl) + ! end do + ! end do case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) return end select - - ! Check for transfer errors and return if failed - if (ErrStat2 >= AbortErrLev) then - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) - return - end if end do + +contains + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + end function end subroutine -subroutine ED_InputSolve1(ModData, Maps, u_ED, T, ErrStat, ErrMsg) - type(ED_InputType), intent(inout) :: u_ED - type(ModDataType), intent(in) :: ModData !< Module data +subroutine BD_InputSolve1(ModData, Maps, u_BD, T, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: u_BD + type(ModDataType), intent(in) :: ModData !< Module data type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type + type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + logical :: ResetDistrLoadFlag + + ErrStat = ErrID_None + ErrMsg = '' + + ResetDistrLoadFlag = .true. + + ! Loop through mappings where this module is the destination + do j = 1, size(ModData%DstMaps) + + ! Get mapping index + i = ModData%DstMaps(j) + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + ! Switch based on mapping key + select case (Maps(i)%Key) + + case ('AD BladeLoad -> BD DistrLoad') + call Transfer_Line2_to_Line2(T%AD%y%rotors(1)%BladeLoad(Maps(i)%DstIns), & + u_BD%DistrLoad, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), & + T%BD%y(Maps(i)%DstIns)%BldMotion) + if (Failed()) return + ! call SumMeshLoads(Maps(i)%MeshTmp, u_BD%DistrLoad, ResetDistrLoadFlag) + + case ('ED BladeRoot -> BD RootMotion') + call Transfer_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%DstIns), & + u_BD%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + case default + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + return + end select + end do + +contains + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + end function +end subroutine + +subroutine ED_InputSolve1(ModData, Maps, u_ED, T, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: u_ED + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_InputSolve' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i - logical :: ED_ResetHubLoadsFlag - logical :: ED_ResetNacelleLoadsFlag + integer(IntKi) :: i, j + logical :: ResetHubLoads + logical :: ResetNacelleLoads + logical :: ResetPlatformLoads + logical :: ResetBladeLoads + logical :: ResetTowerLoads ErrStat = ErrID_None ErrMsg = '' - ED_ResetHubLoadsFlag = .true. - ED_ResetNacelleLoadsFlag = .true. + ResetHubLoads = .true. + ResetNacelleLoads = .true. + ResetPlatformLoads = .true. + ResetBladeLoads = .true. + ResetTowerLoads = .true. - ! Loop through mappings that set this module's inputs - do i = 1, size(Maps) + ! Zero tower and platform added mass + ! u_ED%TwrAddedMass = 0.0_ReKi + ! u_ED%PtfmAddedMass = 0.0_ReKi - ! If this is not the destination module, cycle - if (ModData%Idx /= Maps(i)%DstModIdx) cycle + ! Loop through mappings where this module is the destination + do j = 1, size(ModData%DstMaps) + + ! Get mapping index + i = ModData%DstMaps(j) ! If mapping source has not been calculated, cycle if (.not. Maps(i)%Ready) cycle + ! Switch based on mapping key select case (Maps(i)%Key) + case ('AD BladeLoad -> ED BladeLoad') - call Transfer_Line2_to_Point(T%AD%y%rotors(1)%BladeLoad(Maps(i)%Idx), & - u_ED%BladePtLoads(Maps(i)%Idx), & + + call Transfer_Line2_to_Point(T%AD%y%rotors(1)%BladeLoad(Maps(i)%i1), & + u_ED%BladePtLoads(Maps(i)%i1), & Maps(i)%MeshMap, ErrStat2, ErrMsg2, & - T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%Idx), & - T%ED%y%BladeLn2Mesh(Maps(i)%Idx)) + T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%i1), & + T%ED%y%BladeLn2Mesh(Maps(i)%i1)) + if (Failed()) return + ! call Transfer_Line2_to_Point(T%AD%y%rotors(1)%BladeLoad(Maps(i)%i1), & + ! ! u_ED%BladePtLoads(Maps(i)%i1), & + ! Maps(i)%MeshTmp, & + ! Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + ! T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%i1), & + ! T%ED%y%BladeLn2Mesh(Maps(i)%i1)) + ! if (Failed()) return + ! call SumMeshLoads(Maps(i)%MeshTmp, u_ED%BladePtLoads(Maps(i)%i1), ResetBladeLoads) case ('AD NacelleLoad -> ED NacelleLoad') - call ED_ResetNacelleLoads() call Transfer_Point_to_Point(T%AD%y%rotors(1)%NacelleLoad, & Maps(i)%MeshTmp, & Maps(i)%MeshMap, ErrStat2, ErrMsg2, & T%AD%Input(1)%rotors(1)%NacelleMotion, & T%ED%y%NacelleMotion) - u_ED%NacelleLoads%Force = u_ED%NacelleLoads%Force + Maps(i)%MeshTmp%Force - u_ED%NacelleLoads%Moment = u_ED%NacelleLoads%Moment + Maps(i)%MeshTmp%Moment + if (Failed()) return + call SumMeshLoads(Maps(i)%MeshTmp, u_ED%NacelleLoads, ResetNacelleLoads) case ('AD HubLoad -> ED HubLoad') - call ED_ResetHubLoads() call Transfer_Point_to_Point(T%AD%y%rotors(1)%HubLoad, & Maps(i)%MeshTmp, & Maps(i)%MeshMap, ErrStat2, ErrMsg2, & T%AD%Input(1)%rotors(1)%HubMotion, & T%ED%y%HubPtMotion) - u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force - u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + if (Failed()) return + call SumMeshLoads(Maps(i)%MeshTmp, u_ED%HubPtLoad, ResetHubLoads) case ('AD TFinLoad -> ED TFinLoad') call Transfer_Point_to_Point(T%AD%y%rotors(1)%TFinLoad, & - u_ED%TFinCMLoads, Maps(i)%MeshMap, & - ErrStat2, ErrMsg2, & + u_ED%TFinCMLoads, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & T%AD%Input(1)%rotors(1)%TFinMotion, & T%ED%y%TFinCMMotion) + if (Failed()) return case ('AD TowerLoad -> ED TowerLoad') call Transfer_Line2_to_Point(T%AD%y%rotors(1)%TowerLoad, & - u_ED%TowerPtLoads, Maps(i)%MeshMap, & - ErrStat2, ErrMsg2, & + Maps(i)%MeshTmp, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & T%AD%Input(1)%rotors(1)%TowerMotion, & T%ED%y%TowerLn2Mesh) + if (Failed()) return + call SumMeshLoads(Maps(i)%MeshTmp, u_ED%TowerPtLoads, ResetTowerLoads) case ('BD ReactionForce -> ED HubLoad') - call ED_ResetHubLoads() call Transfer_Point_to_Point(T%BD%y(Maps(i)%SrcIns)%ReactionForce, & Maps(i)%MeshTmp, & Maps(i)%MeshMap, ErrStat2, ErrMsg2, & T%BD%Input(1, Maps(i)%SrcIns)%RootMotion, & T%ED%y%HubPtMotion) - u_ED%HubPtLoad%Force = u_ED%HubPtLoad%Force + Maps(i)%MeshTmp%Force - u_ED%HubPtLoad%Moment = u_ED%HubPtLoad%Moment + Maps(i)%MeshTmp%Moment + if (Failed()) return + call SumMeshLoads(Maps(i)%MeshTmp, u_ED%HubPtLoad, ResetHubLoads) + + case ("SrvD Data -> ED Data") + u_ED%GenTrq = T%SrvD%y%GenTrq + u_ED%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + u_ED%BlPitchCom = T%SrvD%y%BlPitchCom + u_ED%YawMom = T%SrvD%y%YawMom case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) return end select + end do + +contains + logical function Failed() + if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine IfW_InputSolve1(ModData, Maps, u_IfW, T, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(inout) :: u_IfW + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'IfW_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mappings where this module is the destination + do j = 1, size(ModData%DstMaps) - ! Check for transfer errors and return if failed - if (ErrStat2 >= AbortErrLev) then - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) + ! Get mapping index + i = ModData%DstMaps(j) + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + ! Switch based on mapping key + select case (Maps(i)%Key) + case ('ED HubMotion -> IfW HubMotion') + + u_IfW%PositionXYZ(:, 1) = T%ED%y%HubPtMotion%Position(:, 1) + u_IfW%HubPosition = T%ED%y%HubPtMotion%Position(:, 1) + & + T%ED%y%HubPtMotion%TranslationDisp(:, 1) + u_IfW%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) + + ! Set Lidar position directly from hub motion mesh + u_IfW%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) + u_IfW%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) + u_IfW%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) + + case default + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) return - end if + end select end do contains - subroutine ED_ResetHubLoads() - if (ED_ResetHubLoadsFlag) then - ED_ResetHubLoadsFlag = .false. - u_ED%HubPtLoad%Force = 0.0_ReKi - u_ED%HubPtLoad%Moment = 0.0_ReKi - end if - end subroutine - subroutine ED_ResetNacelleLoads() - if (ED_ResetNacelleLoadsFlag) then - ED_ResetNacelleLoadsFlag = .false. - u_ED%NacelleLoads%Force = 0.0_ReKi - u_ED%NacelleLoads%Moment = 0.0_ReKi - end if - end subroutine + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + end function end subroutine -subroutine IfW_InputSolve1(ModData, Maps, u_IfW, T, ErrStat, ErrMsg) - type(InflowWind_InputType), intent(inout) :: u_IfW - type(ModDataType), intent(in) :: ModData !< Module data - type(TC_MappingType), intent(inout) :: Maps(:) - type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type - integer(IntKi), intent(out) :: ErrStat - character(*), intent(out) :: ErrMsg +subroutine SrvD_InputSolve1(ModData, Maps, u_SrvD, T, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: u_SrvD + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'SrvD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j ErrStat = ErrID_None ErrMsg = '' + ! Initialize inflow + u_SrvD%WindDir = 0.0 + u_SrvD%HorWindV = 0.0 + if (allocated(u_SrvD%LidSpeed)) u_SrvD%LidSpeed = 0.0 + if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 + if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 + if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 + + ! Loop through mappings where this module is the destination + do j = 1, size(ModData%DstMaps) + + ! Get mapping index + i = ModData%DstMaps(j) + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + ! Switch based on mapping key + select case (Maps(i)%Key) + + case ('BD BladeMotion -> SrvD BladeMotion') + + case ("BD Data -> SrvD Data") + + case ("BD RootM -> SrvD RootM") + + u_SrvD%RootMxc(Maps(i)%SrcIns) = T%BD%y(Maps(i)%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Maps(i)%SrcIns)) + & + T%BD%y(Maps(i)%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Maps(i)%SrcIns)) + u_SrvD%RootMyc(Maps(i)%SrcIns) = -T%BD%y(Maps(i)%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Maps(i)%SrcIns)) + & + T%BD%y(Maps(i)%SrcIns)%RootMyr*cos(T%ED%y%BlPitch(Maps(i)%SrcIns)) + + case ("ED RootM -> SrvD RootM") + + u_SrvD%RootMxc = T%ED%y%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 + + case ("ED Data -> SrvD Data") + + u_SrvD%YawAngle = T%ED%y%YawAngle ! nacelle yaw plus platform yaw + + u_SrvD%Yaw = T%ED%y%Yaw ! nacelle yaw + u_SrvD%YawRate = T%ED%y%YawRate + u_SrvD%BlPitch = T%ED%y%BlPitch + u_SrvD%LSS_Spd = T%ED%y%LSS_Spd + u_SrvD%HSS_Spd = T%ED%y%HSS_Spd + u_SrvD%RotSpeed = T%ED%y%RotSpeed + + u_SrvD%YawBrTAxp = T%ED%y%YawBrTAxp + u_SrvD%YawBrTAyp = T%ED%y%YawBrTAyp + u_SrvD%LSSTipPxa = T%ED%y%LSSTipPxa + + u_SrvD%LSSTipMxa = T%ED%y%LSSTipMxa + u_SrvD%LSSTipMya = T%ED%y%LSSTipMya + u_SrvD%LSSTipMza = T%ED%y%LSSTipMza + u_SrvD%LSSTipMys = T%ED%y%LSSTipMys + u_SrvD%LSSTipMzs = T%ED%y%LSSTipMzs + + u_SrvD%YawBrMyn = T%ED%y%YawBrMyn + u_SrvD%YawBrMzn = T%ED%y%YawBrMzn + u_SrvD%NcIMURAxs = T%ED%y%NcIMURAxs + u_SrvD%NcIMURAys = T%ED%y%NcIMURAys + u_SrvD%NcIMURAzs = T%ED%y%NcIMURAzs + + u_SrvD%RotPwr = T%ED%y%RotPwr + + u_SrvD%LSShftFxa = T%ED%y%LSShftFxa + u_SrvD%LSShftFys = T%ED%y%LSShftFys + u_SrvD%LSShftFzs = T%ED%y%LSShftFzs + + case ('ED PlatformMotion -> SrvD PlatformMotion') + case ('ED TowerMotion -> SrvD TowerMotion') + case ('ED NacelleMotion -> SrvD NacelleMotion') + case ('ED BladeMotion -> SrvD BladeMotion') + + case ("IfW Data -> SrvD Data") + + u_SrvD%WindDir = atan2(T%IfW%y%VelocityUVW(2, 1), T%IfW%y%VelocityUVW(1, 1)) + u_SrvD%HorWindV = sqrt(T%IfW%y%VelocityUVW(1, 1)**2 + T%IfW%y%VelocityUVW(2, 1)**2) + if (allocated(T%IfW%y%lidar%LidSpeed)) u_SrvD%LidSpeed = T%IfW%y%lidar%LidSpeed + if (allocated(T%IfW%y%lidar%MsrPositionsX)) u_SrvD%MsrPositionsX = T%IfW%y%lidar%MsrPositionsX + if (allocated(T%IfW%y%lidar%MsrPositionsY)) u_SrvD%MsrPositionsY = T%IfW%y%lidar%MsrPositionsY + if (allocated(T%IfW%y%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ + + case default + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + return + end select + end do + + ! the nacelle yaw error estimate (positive about zi-axis) + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle + +contains + logical function Failed() + Failed = ErrStat2 >= AbortErrLev + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + end function +end subroutine + +subroutine SumMeshLoads(SrcMesh, DstMesh, DstResetFlag) + type(MeshType), intent(in) :: SrcMesh + type(MeshType), intent(inout) :: DstMesh + logical, intent(inout) :: DstResetFlag + if (DstResetFlag) then + DstResetFlag = .false. + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = 0.0_ReKi + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = 0.0_ReKi + end if + if (DstMesh%fieldmask(MASKID_FORCE)) DstMesh%Force = DstMesh%Force + SrcMesh%Force + if (DstMesh%fieldmask(MASKID_MOMENT)) DstMesh%Moment = DstMesh%Moment + SrcMesh%Moment end subroutine subroutine FAST_CalcOutput(ModData, Maps, this_time, this_state, T, ErrStat, ErrMsg) @@ -1068,9 +1455,7 @@ subroutine FAST_CalcOutput(ModData, Maps, this_time, this_state, T, ErrStat, Err end select ! Set updated flag in mappings where this module is the source - do i = 1, size(Maps) - if (Maps(i)%SrcModIdx == ModData%Idx) Maps(i)%Ready = .true. - end do + Maps(ModData%SrcMaps)%Ready = .true. contains logical function Failed() @@ -1312,9 +1697,9 @@ subroutine FAST_CopyStates(ModData, T, Src, Dst, CtrlCode, ErrStat, ErrMsg) ! TODO: Fix inconsistent function name call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - ! call HD_CopyDiscState(T%HD%xd(Src), T%HD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - ! call HD_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return - ! call HD_CopyOtherState(T%HD%OtherSt(Src), T%HD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HydroDyn_CopyDiscState(T%HD%xd(Src), T%HD%xd(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HydroDyn_CopyConstrState(T%HD%z(Src), T%HD%z(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + ! call HydroDyn_CopyOtherState(T%HD%OtherSt(Src), T%HD%OtherSt(Dst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return ! case (Module_IceD) ! case (Module_IceF) @@ -1356,8 +1741,9 @@ logical function Failed() end function end subroutine -subroutine FAST_ResetRemapFlags(ModData, T, ErrStat, ErrMsg) - type(ModDataType), intent(in) :: ModData !< Module data +subroutine FAST_ResetRemapFlags(Mods, Maps, T, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: Mods(:) !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1365,151 +1751,160 @@ subroutine FAST_ResetRemapFlags(ModData, T, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_ResetRemapFlags' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: k + integer(IntKi) :: i, k ErrStat = ErrID_None ErrMsg = '' - ! Select based on module ID - select case (ModData%ID) + ! Reset remap flags in mapping temporary meshes + do i = 1, size(Maps) + if (associated(Maps(i)%MeshTmp%RemapFlag)) Maps(i)%MeshTmp%RemapFlag = .false. + end do - case (Module_AD) + do i = 1, size(Mods) - if (T%AD%Input(1)%rotors(1)%HubMotion%Committed) then - T%AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .false. - T%AD%y%rotors(1)%HubLoad%RemapFlag = .false. - end if + ! Select based on module ID + select case (Mods(i)%ID) - if (T%AD%Input(1)%rotors(1)%TowerMotion%Committed) then - T%AD%Input(1)%rotors(1)%TowerMotion%RemapFlag = .false. + case (Module_AD) - if (T%AD%y%rotors(1)%TowerLoad%Committed) then - T%AD%y%rotors(1)%TowerLoad%RemapFlag = .false. + if (T%AD%Input(1)%rotors(1)%HubMotion%Committed) then + T%AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .false. + T%AD%y%rotors(1)%HubLoad%RemapFlag = .false. end if - end if - if (T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) then - T%AD%Input(1)%rotors(1)%NacelleMotion%RemapFlag = .false. - T%AD%y%rotors(1)%NacelleLoad%RemapFlag = .false. - end if + if (T%AD%Input(1)%rotors(1)%TowerMotion%Committed) then + T%AD%Input(1)%rotors(1)%TowerMotion%RemapFlag = .false. - if (T%AD%Input(1)%rotors(1)%TFinMotion%Committed) then - T%AD%Input(1)%rotors(1)%TFinMotion%RemapFlag = .false. - T%AD%y%rotors(1)%TFinLoad%RemapFlag = .false. - end if + if (T%AD%y%rotors(1)%TowerLoad%Committed) then + T%AD%y%rotors(1)%TowerLoad%RemapFlag = .false. + end if + end if - do k = 1, size(T%AD%Input(1)%rotors(1)%BladeMotion) - T%AD%Input(1)%rotors(1)%BladeRootMotion(k)%RemapFlag = .false. - T%AD%Input(1)%rotors(1)%BladeMotion(k)%RemapFlag = .false. - T%AD%y%rotors(1)%BladeLoad(k)%RemapFlag = .false. - end do + if (T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) then + T%AD%Input(1)%rotors(1)%NacelleMotion%RemapFlag = .false. + T%AD%y%rotors(1)%NacelleLoad%RemapFlag = .false. + end if - case (Module_BD) + if (T%AD%Input(1)%rotors(1)%TFinMotion%Committed) then + T%AD%Input(1)%rotors(1)%TFinMotion%RemapFlag = .false. + T%AD%y%rotors(1)%TFinLoad%RemapFlag = .false. + end if - T%BD%Input(1, ModData%Ins)%RootMotion%RemapFlag = .false. - T%BD%Input(1, ModData%Ins)%PointLoad%RemapFlag = .false. - T%BD%Input(1, ModData%Ins)%DistrLoad%RemapFlag = .false. - T%BD%Input(1, ModData%Ins)%HubMotion%RemapFlag = .false. + do k = 1, size(T%AD%Input(1)%rotors(1)%BladeMotion) + T%AD%Input(1)%rotors(1)%BladeRootMotion(k)%RemapFlag = .false. + T%AD%Input(1)%rotors(1)%BladeMotion(k)%RemapFlag = .false. + T%AD%y%rotors(1)%BladeLoad(k)%RemapFlag = .false. + end do - T%BD%y(ModData%Ins)%ReactionForce%RemapFlag = .false. - T%BD%y(ModData%Ins)%BldMotion%RemapFlag = .false. + case (Module_BD) - case (Module_ED) + T%BD%Input(1, Mods(i)%Ins)%RootMotion%RemapFlag = .false. + T%BD%Input(1, Mods(i)%Ins)%PointLoad%RemapFlag = .false. + T%BD%Input(1, Mods(i)%Ins)%DistrLoad%RemapFlag = .false. + T%BD%Input(1, Mods(i)%Ins)%HubMotion%RemapFlag = .false. - T%ED%Input(1)%PlatformPtMesh%RemapFlag = .false. - T%ED%y%PlatformPtMesh%RemapFlag = .false. - T%ED%Input(1)%TowerPtLoads%RemapFlag = .false. - T%ED%y%TowerLn2Mesh%RemapFlag = .false. - do K = 1, size(T%ED%y%BladeRootMotion) - T%ED%y%BladeRootMotion(K)%RemapFlag = .false. - end do - if (allocated(T%ED%Input(1)%BladePtLoads)) then - do K = 1, size(T%ED%Input(1)%BladePtLoads) - T%ED%Input(1)%BladePtLoads(K)%RemapFlag = .false. - T%ED%y%BladeLn2Mesh(K)%RemapFlag = .false. + T%BD%y(Mods(i)%Ins)%ReactionForce%RemapFlag = .false. + T%BD%y(Mods(i)%Ins)%BldMotion%RemapFlag = .false. + + case (Module_ED) + + T%ED%Input(1)%PlatformPtMesh%RemapFlag = .false. + T%ED%y%PlatformPtMesh%RemapFlag = .false. + T%ED%Input(1)%TowerPtLoads%RemapFlag = .false. + T%ED%y%TowerLn2Mesh%RemapFlag = .false. + do K = 1, size(T%ED%y%BladeRootMotion) + T%ED%y%BladeRootMotion(K)%RemapFlag = .false. end do - end if - T%ED%Input(1)%NacelleLoads%RemapFlag = .false. - T%ED%y%NacelleMotion%RemapFlag = .false. - T%ED%Input(1)%TFinCMLoads%RemapFlag = .false. - T%ED%y%TFinCMMotion%RemapFlag = .false. - T%ED%Input(1)%HubPtLoad%RemapFlag = .false. - T%ED%y%HubPtMotion%RemapFlag = .false. - - case (Module_ExtPtfm) - - if (T%ExtPtfm%Input(1)%PtfmMesh%Committed) then - T%ExtPtfm%Input(1)%PtfmMesh%RemapFlag = .false. - T%ExtPtfm%y%PtfmMesh%RemapFlag = .false. - end if + if (allocated(T%ED%Input(1)%BladePtLoads)) then + do K = 1, size(T%ED%Input(1)%BladePtLoads) + T%ED%Input(1)%BladePtLoads(K)%RemapFlag = .false. + T%ED%y%BladeLn2Mesh(K)%RemapFlag = .false. + end do + end if + T%ED%Input(1)%NacelleLoads%RemapFlag = .false. + T%ED%y%NacelleMotion%RemapFlag = .false. + T%ED%Input(1)%TFinCMLoads%RemapFlag = .false. + T%ED%y%TFinCMMotion%RemapFlag = .false. + T%ED%Input(1)%HubPtLoad%RemapFlag = .false. + T%ED%y%HubPtMotion%RemapFlag = .false. + + case (Module_ExtPtfm) + + if (T%ExtPtfm%Input(1)%PtfmMesh%Committed) then + T%ExtPtfm%Input(1)%PtfmMesh%RemapFlag = .false. + T%ExtPtfm%y%PtfmMesh%RemapFlag = .false. + end if - case (Module_FEAM) + case (Module_FEAM) - T%FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .false. - T%FEAM%y%PtFairleadLoad%RemapFlag = .false. + T%FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .false. + T%FEAM%y%PtFairleadLoad%RemapFlag = .false. - case (Module_HD) + case (Module_HD) - T%HD%Input(1)%PRPMesh%RemapFlag = .false. - if (T%HD%Input(1)%WAMITMesh%Committed) then - T%HD%Input(1)%WAMITMesh%RemapFlag = .false. - T%HD%y%WAMITMesh%RemapFlag = .false. - end if - if (T%HD%Input(1)%Morison%Mesh%Committed) then - T%HD%Input(1)%Morison%Mesh%RemapFlag = .false. - T%HD%y%Morison%Mesh%RemapFlag = .false. - end if + T%HD%Input(1)%PRPMesh%RemapFlag = .false. + if (T%HD%Input(1)%WAMITMesh%Committed) then + T%HD%Input(1)%WAMITMesh%RemapFlag = .false. + T%HD%y%WAMITMesh%RemapFlag = .false. + end if + if (T%HD%Input(1)%Morison%Mesh%Committed) then + T%HD%Input(1)%Morison%Mesh%RemapFlag = .false. + T%HD%y%Morison%Mesh%RemapFlag = .false. + end if - case (Module_IceD) + case (Module_IceD) - if (T%IceD%Input(1, ModData%Ins)%PointMesh%Committed) then - T%IceD%Input(1, ModData%Ins)%PointMesh%RemapFlag = .false. - T%IceD%y(ModData%Ins)%PointMesh%RemapFlag = .false. - end if + if (T%IceD%Input(1, Mods(i)%Ins)%PointMesh%Committed) then + T%IceD%Input(1, Mods(i)%Ins)%PointMesh%RemapFlag = .false. + T%IceD%y(Mods(i)%Ins)%PointMesh%RemapFlag = .false. + end if - case (Module_IceF) + case (Module_IceF) - if (T%IceF%Input(1)%iceMesh%Committed) then - T%IceF%Input(1)%iceMesh%RemapFlag = .false. - T%IceF%y%iceMesh%RemapFlag = .false. - end if + if (T%IceF%Input(1)%iceMesh%Committed) then + T%IceF%Input(1)%iceMesh%RemapFlag = .false. + T%IceF%y%iceMesh%RemapFlag = .false. + end if - case (Module_MAP) + case (Module_MAP) - T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. - T%MAP%y%PtFairleadLoad%RemapFlag = .false. + T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. + T%MAP%y%PtFairleadLoad%RemapFlag = .false. - case (Module_MD) + case (Module_MD) - T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. - T%MD%y%CoupledLoads(1)%RemapFlag = .false. + T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. + T%MD%y%CoupledLoads(1)%RemapFlag = .false. - case (Module_Orca) + case (Module_Orca) - T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. - T%Orca%y%PtfmMesh%RemapFlag = .false. + T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. + T%Orca%y%PtfmMesh%RemapFlag = .false. - case (Module_SD) + case (Module_SD) - if (T%SD%Input(1)%TPMesh%Committed) then - T%SD%Input(1)%TPMesh%RemapFlag = .false. - T%SD%y%Y1Mesh%RemapFlag = .false. - end if + if (T%SD%Input(1)%TPMesh%Committed) then + T%SD%Input(1)%TPMesh%RemapFlag = .false. + T%SD%y%Y1Mesh%RemapFlag = .false. + end if - if (T%SD%Input(1)%LMesh%Committed) then - T%SD%Input(1)%LMesh%RemapFlag = .false. - T%SD%y%Y2Mesh%RemapFlag = .false. - T%SD%y%Y3Mesh%RemapFlag = .false. - end if + if (T%SD%Input(1)%LMesh%Committed) then + T%SD%Input(1)%LMesh%RemapFlag = .false. + T%SD%y%Y2Mesh%RemapFlag = .false. + T%SD%y%Y3Mesh%RemapFlag = .false. + end if - end select + end select + + end do end subroutine -subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMsg, dUdu, dUdy) +subroutine FAST_LinearizeMappings(ModData, ModOrder, Maps, T, ErrStat, ErrMsg, dUdu, dUdy) type(ModDataType), intent(in) :: ModData(:) !< Module data integer(IntKi), intent(in) :: ModOrder(:) - type(TC_MappingType), intent(inout) :: Mappings(:) + type(TC_MappingType), intent(inout) :: Maps(:) type(FAST_TurbineType), target, intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1518,43 +1913,47 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Mappings, T, ErrStat, ErrMs character(*), parameter :: RoutineName = 'FAST_LinearizeMappings' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j, k - integer(IntKi) :: iiu, iiy + integer(IntKi) :: i ErrStat = ErrID_None ErrMsg = '' ! Loop through mapping array - do j = 1, size(Mappings) - - ! If source and destination modules are not in tight coupling, cycle - if ((.not. ModData(Mappings(j)%DstModIdx)%IsTC) .or. & - (.not. ModData(Mappings(j)%SrcModIdx)%IsTC)) cycle + do i = 1, size(Maps) - ! Get input/output module instances - iiu = Mappings(j)%DstIns - iiy = Mappings(j)%SrcIns + ! If source or destination modules are not in tight coupling + ! or mapping is non-mesh, cycle + if ((.not. ModData(Maps(i)%DstModIdx)%IsTC) .or. & + (.not. ModData(Maps(i)%SrcModIdx)%IsTC) .or. & + (Maps(i)%Typ == Map_NonMesh)) cycle - ! Select based on mapping Key (must match Key in m%Mappings in Solver.f90) - select case (Mappings(j)%Key) + ! Select based on mapping Key + select case (Maps(i)%Key) case ('ED BladeRoot -> BD RootMotion') - call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(iiu), T%BD%Input(1, iiu)%RootMotion, Mappings(j)%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return + call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%DstIns), & + T%BD%Input(1, Maps(i)%DstIns)%RootMotion, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return case ('BD ReactionForce -> ED HubLoad') - call Linearize_Point_to_Point(T%BD%y(iiy)%ReactionForce, T%ED%u%HubPtLoad, Mappings(j)%MeshMap, ErrStat2, ErrMsg2, & - T%BD%Input(1, iiy)%RootMotion, T%ED%y%HubPtMotion); if (Failed()) return ! <- displaced positions for load calculations + call Linearize_Point_to_Point(T%BD%y(Maps(i)%SrcIns)%ReactionForce, & + T%ED%u%HubPtLoad, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%BD%Input(1, Maps(i)%SrcIns)%RootMotion, & + T%ED%y%HubPtMotion) + if (Failed()) return case default - call SetErrStat(ErrID_Fatal, 'Invalid Mapping Key: '//Mappings(j)%Key, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) return end select if (present(dUdu)) then - call dUduSetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) + call dUduSetBlocks(Maps(i), ModData(Maps(i)%SrcModIdx), ModData(Maps(i)%DstModIdx), Maps(i)%MeshMap%dM) end if if (present(dUdy)) then - call dUdySetBlocks(Mappings(j), ModData(Mappings(j)%SrcModIdx), ModData(Mappings(j)%DstModIdx), Mappings(j)%MeshMap%dM) + call dUdySetBlocks(Maps(i), ModData(Maps(i)%SrcModIdx), ModData(Maps(i)%DstModIdx), Maps(i)%MeshMap%dM) end if end do @@ -1582,9 +1981,9 @@ subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) end subroutine subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) - type(TC_MappingType), intent(inout) :: M !< Mapping - type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data - type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data + type(TC_MappingType), intent(inout) :: M !< Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data + type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data ! Load identity if (allocated(MML%li)) then @@ -1598,7 +1997,7 @@ subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) end if ! Moment to output translation displacement - if (allocated(Mappings(j)%MeshMap%dM%m_uD)) then + if (allocated(Maps(i)%MeshMap%dM%m_uD)) then call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) end if @@ -1649,10 +2048,10 @@ subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) do ic = 1, size(ColVars) if (ColVars(ic)%Field /= ColField) cycle nSize = ColVars(ic)%Num - Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) = Gbl(RowVars(ir)%iGblSol, ColVars(ic)%iGblSol) + & - Loc(m:m + mSize - 1, n:n + nSize - 1) - ! write (*, *) 'Rows = ', RowVars(ir)%iGblSol - ! write (*, *) 'Cols = ', ColVars(ic)%iGblSol + Gbl(RowVars(ir)%iSol, ColVars(ic)%iSol) = Gbl(RowVars(ir)%iSol, ColVars(ic)%iSol) + & + Loc(m:m + mSize - 1, n:n + nSize - 1) + ! write (*, *) 'Rows = ', RowVars(ir)%iSol + ! write (*, *) 'Cols = ', ColVars(ic)%iSol ! write (*, *) 'Shape = ', mSize, nSize ! write (*, '(A,*(ES14.5))') 'Values = ', Loc(m:m + mSize - 1, n:n + nSize - 1) n = n + nSize @@ -1660,6 +2059,7 @@ subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) m = m + mSize end do end subroutine + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index aa09685318..9e2cee19a4 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -91,26 +91,30 @@ typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - # ..... Tight Coupling Generalized Alpha Solver Data ............. # Mapping Type -typedef ^ TC_MappingType character(VarNameLen) Key - - - "Mapping Key" - -typedef ^ ^ character(VarNameLen) SrcMeshName - - - "source mesh name" - -typedef ^ ^ character(VarNameLen) DstMeshName - - - "destination mesh name" - +param ^ - IntKi Map_LoadMesh - 1 - "Load mesh mapping type" - +param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - +param ^ - IntKi Map_NonMesh - 3 - "Non mesh mapping type" - +typedef ^ TC_MappingType character(VarNameLen) Key - '' - "Mapping Key" - +typedef ^ ^ character(VarNameLen) SrcMeshName - '' - "source mesh name" - +typedef ^ ^ character(VarNameLen) DstMeshName - '' - "destination mesh name" - typedef ^ ^ character(VarNameLen) SrcDispMeshName - '' - "source displacement mesh name [if IsLoad=true]" - typedef ^ ^ character(VarNameLen) DstDispMeshName - '' - "destination displacement mesh name [if IsLoad=true]" - -typedef ^ ^ IntKi SrcModID - - - "Output module ID" - -typedef ^ ^ IntKi DstModID - - - "Input module ID" - -typedef ^ ^ IntKi SrcModIdx - - - "Output module index in ModData array" - -typedef ^ ^ IntKi DstModIdx - - - "Input module index in ModData array" - -typedef ^ ^ IntKi SrcIns - - - "Output module Instance" - -typedef ^ ^ IntKi DstIns - - - "Input module Instance" - +typedef ^ ^ IntKi i1 - 0 - "Optional index for specifying transfers" - +typedef ^ ^ IntKi i2 - 0 - "Optional index for specifying transfers" - +typedef ^ ^ IntKi SrcModIdx - 0 - "Output module index in ModData array" - +typedef ^ ^ IntKi DstModIdx - 0 - "Input module index in ModData array" - +typedef ^ ^ IntKi SrcModID - 0 - "Output module ID" - +typedef ^ ^ IntKi DstModID - 0 - "Input module ID" - +typedef ^ ^ IntKi SrcIns - 0 - "Output module Instance" - +typedef ^ ^ IntKi DstIns - 0 - "Input module Instance" - typedef ^ ^ IntKi SrcVarIdx : - - "motion variable index" - typedef ^ ^ IntKi DstVarIdx : - - "motion variable index" - -typedef ^ ^ IntKi SrcDispVarIdx - - - "source displacement var index [if IsLoad=true]" - -typedef ^ ^ IntKi DstDispVarIdx - - - "destination displacement var index [if IsLoad=true]" - -typedef ^ ^ IntKi Idx - - - "Optional index for specifying transfers" - +typedef ^ ^ IntKi SrcDispVarIdx - 0 - "source displacement var index [if IsLoad=true]" - +typedef ^ ^ IntKi DstDispVarIdx - 0 - "destination displacement var index [if IsLoad=true]" - +typedef ^ ^ IntKi Typ - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - +typedef ^ ^ logical Ready - F - "Flag indicating output has been ready to be transferred" - typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from output variable to input variable" - -typedef ^ ^ logical IsLoad - - - "Flag indicating if this is a load or motion mapping" - -typedef ^ ^ logical Ready - - - "Flag indicating output has been ready to be transferred" - # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - @@ -138,12 +142,13 @@ typedef ^ ^ IntKi iJU 2 - - typedef ^ ^ IntKi iJUT 2 - - "Indices of Jacobian input variables from tight coupling" - typedef ^ ^ IntKi iJL : - - "Indices of Jacobian load variables" - typedef ^ ^ IntKi ixqd :: - - "" - -typedef ^ ^ IntKi iModAll : - - "ModData index order for all modules" - +typedef ^ ^ IntKi iModInit : - - "ModData index order for step 0 initialization" - typedef ^ ^ IntKi iModTC : - - "ModData index order for tight coupling modules" - typedef ^ ^ IntKi iModBD : - - "ModData index order for BD modules" - typedef ^ ^ IntKi iModOpt1 : - - "ModData index order for option 1 modules" - typedef ^ ^ IntKi iModOpt1US : - - "ModData index order for option 1 modules to update states" - typedef ^ ^ IntKi iModOpt2 : - - "ModData index order for option 2 modules" - +typedef ^ ^ IntKi iModPost : - - "ModData index order for post option 1 modules" - # Misc/Optimization variables typedef ^ TC_MiscVarType R8Ki q :: - - "" - @@ -174,6 +179,7 @@ typedef ^ ^ R8Ki dq :: - - typedef ^ ^ R8Ki dx : - - "Change in x" - typedef ^ ^ R8Ki du : - - "" - typedef ^ ^ R8Ki UDiff : - - "" - +typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - typedef ^ ^ TC_MappingType Mappings : - - "Array of mesh mappings in solver" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 4997bfbe1e..38954018cd 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -73,6 +73,9 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 18 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_LoadMesh = 1 ! Load mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_MotionMesh = 2 ! Motion mesh mapping type [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Map_NonMesh = 3 ! Non mesh mapping type [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -111,26 +114,27 @@ MODULE FAST_Types ! ======================= ! ========= TC_MappingType ======= TYPE, PUBLIC :: TC_MappingType - character(VarNameLen) :: Key !< Mapping Key [-] - character(VarNameLen) :: SrcMeshName !< source mesh name [-] - character(VarNameLen) :: DstMeshName !< destination mesh name [-] + character(VarNameLen) :: Key = '' !< Mapping Key [-] + character(VarNameLen) :: SrcMeshName = '' !< source mesh name [-] + character(VarNameLen) :: DstMeshName = '' !< destination mesh name [-] character(VarNameLen) :: SrcDispMeshName = '' !< source displacement mesh name [if IsLoad=true] [-] character(VarNameLen) :: DstDispMeshName = '' !< destination displacement mesh name [if IsLoad=true] [-] - INTEGER(IntKi) :: SrcModID = 0_IntKi !< Output module ID [-] - INTEGER(IntKi) :: DstModID = 0_IntKi !< Input module ID [-] - INTEGER(IntKi) :: SrcModIdx = 0_IntKi !< Output module index in ModData array [-] - INTEGER(IntKi) :: DstModIdx = 0_IntKi !< Input module index in ModData array [-] - INTEGER(IntKi) :: SrcIns = 0_IntKi !< Output module Instance [-] - INTEGER(IntKi) :: DstIns = 0_IntKi !< Input module Instance [-] + INTEGER(IntKi) :: i1 = 0 !< Optional index for specifying transfers [-] + INTEGER(IntKi) :: i2 = 0 !< Optional index for specifying transfers [-] + INTEGER(IntKi) :: SrcModIdx = 0 !< Output module index in ModData array [-] + INTEGER(IntKi) :: DstModIdx = 0 !< Input module index in ModData array [-] + INTEGER(IntKi) :: SrcModID = 0 !< Output module ID [-] + INTEGER(IntKi) :: DstModID = 0 !< Input module ID [-] + INTEGER(IntKi) :: SrcIns = 0 !< Output module Instance [-] + INTEGER(IntKi) :: DstIns = 0 !< Input module Instance [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcVarIdx !< motion variable index [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstVarIdx !< motion variable index [-] - INTEGER(IntKi) :: SrcDispVarIdx = 0_IntKi !< source displacement var index [if IsLoad=true] [-] - INTEGER(IntKi) :: DstDispVarIdx = 0_IntKi !< destination displacement var index [if IsLoad=true] [-] - INTEGER(IntKi) :: Idx = 0_IntKi !< Optional index for specifying transfers [-] + INTEGER(IntKi) :: SrcDispVarIdx = 0 !< source displacement var index [if IsLoad=true] [-] + INTEGER(IntKi) :: DstDispVarIdx = 0 !< destination displacement var index [if IsLoad=true] [-] + INTEGER(IntKi) :: Typ = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] + LOGICAL :: Ready = .false. !< Flag indicating output has been ready to be transferred [-] TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] TYPE(MeshMapType) :: MeshMap !< Mesh mapping from output variable to input variable [-] - LOGICAL :: IsLoad = .false. !< Flag indicating if this is a load or motion mapping [-] - LOGICAL :: Ready = .false. !< Flag indicating output has been ready to be transferred [-] END TYPE TC_MappingType ! ======================= ! ========= TC_ParameterType ======= @@ -160,12 +164,13 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(1:2) :: iJUT = 0_IntKi !< Indices of Jacobian input variables from tight coupling [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iJL !< Indices of Jacobian load variables [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixqd !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModAll !< ModData index order for all modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModInit !< ModData index order for step 0 initialization [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModTC !< ModData index order for tight coupling modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModBD !< ModData index order for BD modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1 !< ModData index order for option 1 modules [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt1US !< ModData index order for option 1 modules to update states [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModOpt2 !< ModData index order for option 2 modules [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iModPost !< ModData index order for post option 1 modules [-] END TYPE TC_ParameterType ! ======================= ! ========= TC_MiscVarType ======= @@ -198,6 +203,7 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< Change in x [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: UDiff !< [-] + LOGICAL :: ConvWarn = .false. !< Flag to warn about convergence failure [-] TYPE(TC_MappingType) , DIMENSION(:), ALLOCATABLE :: Mappings !< Array of mesh mappings in solver [-] END TYPE TC_MiscVarType ! ======================= @@ -1523,10 +1529,12 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, DstTC_MappingTypeData%DstMeshName = SrcTC_MappingTypeData%DstMeshName DstTC_MappingTypeData%SrcDispMeshName = SrcTC_MappingTypeData%SrcDispMeshName DstTC_MappingTypeData%DstDispMeshName = SrcTC_MappingTypeData%DstDispMeshName - DstTC_MappingTypeData%SrcModID = SrcTC_MappingTypeData%SrcModID - DstTC_MappingTypeData%DstModID = SrcTC_MappingTypeData%DstModID + DstTC_MappingTypeData%i1 = SrcTC_MappingTypeData%i1 + DstTC_MappingTypeData%i2 = SrcTC_MappingTypeData%i2 DstTC_MappingTypeData%SrcModIdx = SrcTC_MappingTypeData%SrcModIdx DstTC_MappingTypeData%DstModIdx = SrcTC_MappingTypeData%DstModIdx + DstTC_MappingTypeData%SrcModID = SrcTC_MappingTypeData%SrcModID + DstTC_MappingTypeData%DstModID = SrcTC_MappingTypeData%DstModID DstTC_MappingTypeData%SrcIns = SrcTC_MappingTypeData%SrcIns DstTC_MappingTypeData%DstIns = SrcTC_MappingTypeData%DstIns if (allocated(SrcTC_MappingTypeData%SrcVarIdx)) then @@ -1555,15 +1563,14 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, end if DstTC_MappingTypeData%SrcDispVarIdx = SrcTC_MappingTypeData%SrcDispVarIdx DstTC_MappingTypeData%DstDispVarIdx = SrcTC_MappingTypeData%DstDispVarIdx - DstTC_MappingTypeData%Idx = SrcTC_MappingTypeData%Idx + DstTC_MappingTypeData%Typ = SrcTC_MappingTypeData%Typ + DstTC_MappingTypeData%Ready = SrcTC_MappingTypeData%Ready call MeshCopy(SrcTC_MappingTypeData%MeshTmp, DstTC_MappingTypeData%MeshTmp, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return call NWTC_Library_CopyMeshMapType(SrcTC_MappingTypeData%MeshMap, DstTC_MappingTypeData%MeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstTC_MappingTypeData%IsLoad = SrcTC_MappingTypeData%IsLoad - DstTC_MappingTypeData%Ready = SrcTC_MappingTypeData%Ready end subroutine subroutine FAST_DestroyTC_MappingType(TC_MappingTypeData, ErrStat, ErrMsg) @@ -1597,10 +1604,12 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) call RegPack(Buf, InData%DstMeshName) call RegPack(Buf, InData%SrcDispMeshName) call RegPack(Buf, InData%DstDispMeshName) - call RegPack(Buf, InData%SrcModID) - call RegPack(Buf, InData%DstModID) + call RegPack(Buf, InData%i1) + call RegPack(Buf, InData%i2) call RegPack(Buf, InData%SrcModIdx) call RegPack(Buf, InData%DstModIdx) + call RegPack(Buf, InData%SrcModID) + call RegPack(Buf, InData%DstModID) call RegPack(Buf, InData%SrcIns) call RegPack(Buf, InData%DstIns) call RegPack(Buf, allocated(InData%SrcVarIdx)) @@ -1615,11 +1624,10 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) end if call RegPack(Buf, InData%SrcDispVarIdx) call RegPack(Buf, InData%DstDispVarIdx) - call RegPack(Buf, InData%Idx) + call RegPack(Buf, InData%Typ) + call RegPack(Buf, InData%Ready) call MeshPack(Buf, InData%MeshTmp) call NWTC_Library_PackMeshMapType(Buf, InData%MeshMap) - call RegPack(Buf, InData%IsLoad) - call RegPack(Buf, InData%Ready) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1641,14 +1649,18 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstDispMeshName) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SrcModID) + call RegUnpack(Buf, OutData%i1) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DstModID) + call RegUnpack(Buf, OutData%i2) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SrcModIdx) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstModIdx) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcModID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstModID) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SrcIns) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstIns) @@ -1685,14 +1697,12 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstDispVarIdx) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Idx) - if (RegCheckErr(Buf, RoutineName)) return - call MeshUnpack(Buf, OutData%MeshTmp) ! MeshTmp - call NWTC_Library_UnpackMeshMapType(Buf, OutData%MeshMap) ! MeshMap - call RegUnpack(Buf, OutData%IsLoad) + call RegUnpack(Buf, OutData%Typ) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Ready) if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(Buf, OutData%MeshTmp) ! MeshTmp + call NWTC_Library_UnpackMeshMapType(Buf, OutData%MeshMap) ! MeshMap end subroutine subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1753,17 +1763,17 @@ subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTyp end if DstTC_ParameterTypeData%ixqd = SrcTC_ParameterTypeData%ixqd end if - if (allocated(SrcTC_ParameterTypeData%iModAll)) then - LB(1:1) = lbound(SrcTC_ParameterTypeData%iModAll) - UB(1:1) = ubound(SrcTC_ParameterTypeData%iModAll) - if (.not. allocated(DstTC_ParameterTypeData%iModAll)) then - allocate(DstTC_ParameterTypeData%iModAll(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcTC_ParameterTypeData%iModInit)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModInit) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModInit) + if (.not. allocated(DstTC_ParameterTypeData%iModInit)) then + allocate(DstTC_ParameterTypeData%iModInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModAll.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModInit.', ErrStat, ErrMsg, RoutineName) return end if end if - DstTC_ParameterTypeData%iModAll = SrcTC_ParameterTypeData%iModAll + DstTC_ParameterTypeData%iModInit = SrcTC_ParameterTypeData%iModInit end if if (allocated(SrcTC_ParameterTypeData%iModTC)) then LB(1:1) = lbound(SrcTC_ParameterTypeData%iModTC) @@ -1825,6 +1835,18 @@ subroutine FAST_CopyTC_ParameterType(SrcTC_ParameterTypeData, DstTC_ParameterTyp end if DstTC_ParameterTypeData%iModOpt2 = SrcTC_ParameterTypeData%iModOpt2 end if + if (allocated(SrcTC_ParameterTypeData%iModPost)) then + LB(1:1) = lbound(SrcTC_ParameterTypeData%iModPost) + UB(1:1) = ubound(SrcTC_ParameterTypeData%iModPost) + if (.not. allocated(DstTC_ParameterTypeData%iModPost)) then + allocate(DstTC_ParameterTypeData%iModPost(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTC_ParameterTypeData%iModPost.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModPost = SrcTC_ParameterTypeData%iModPost + end if end subroutine subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) @@ -1840,8 +1862,8 @@ subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) if (allocated(TC_ParameterTypeData%ixqd)) then deallocate(TC_ParameterTypeData%ixqd) end if - if (allocated(TC_ParameterTypeData%iModAll)) then - deallocate(TC_ParameterTypeData%iModAll) + if (allocated(TC_ParameterTypeData%iModInit)) then + deallocate(TC_ParameterTypeData%iModInit) end if if (allocated(TC_ParameterTypeData%iModTC)) then deallocate(TC_ParameterTypeData%iModTC) @@ -1858,6 +1880,9 @@ subroutine FAST_DestroyTC_ParameterType(TC_ParameterTypeData, ErrStat, ErrMsg) if (allocated(TC_ParameterTypeData%iModOpt2)) then deallocate(TC_ParameterTypeData%iModOpt2) end if + if (allocated(TC_ParameterTypeData%iModPost)) then + deallocate(TC_ParameterTypeData%iModPost) + end if end subroutine subroutine FAST_PackTC_ParameterType(Buf, Indata) @@ -1898,10 +1923,10 @@ subroutine FAST_PackTC_ParameterType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%ixqd), ubound(InData%ixqd)) call RegPack(Buf, InData%ixqd) end if - call RegPack(Buf, allocated(InData%iModAll)) - if (allocated(InData%iModAll)) then - call RegPackBounds(Buf, 1, lbound(InData%iModAll), ubound(InData%iModAll)) - call RegPack(Buf, InData%iModAll) + call RegPack(Buf, allocated(InData%iModInit)) + if (allocated(InData%iModInit)) then + call RegPackBounds(Buf, 1, lbound(InData%iModInit), ubound(InData%iModInit)) + call RegPack(Buf, InData%iModInit) end if call RegPack(Buf, allocated(InData%iModTC)) if (allocated(InData%iModTC)) then @@ -1928,6 +1953,11 @@ subroutine FAST_PackTC_ParameterType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%iModOpt2), ubound(InData%iModOpt2)) call RegPack(Buf, InData%iModOpt2) end if + call RegPack(Buf, allocated(InData%iModPost)) + if (allocated(InData%iModPost)) then + call RegPackBounds(Buf, 1, lbound(InData%iModPost), ubound(InData%iModPost)) + call RegPack(Buf, InData%iModPost) + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2013,18 +2043,18 @@ subroutine FAST_UnPackTC_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%ixqd) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%iModAll)) deallocate(OutData%iModAll) + if (allocated(OutData%iModInit)) deallocate(OutData%iModInit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%iModAll(LB(1):UB(1)),stat=stat) + allocate(OutData%iModInit(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%iModAll) + call RegUnpack(Buf, OutData%iModInit) if (RegCheckErr(Buf, RoutineName)) return end if if (allocated(OutData%iModTC)) deallocate(OutData%iModTC) @@ -2097,6 +2127,20 @@ subroutine FAST_UnPackTC_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%iModOpt2) if (RegCheckErr(Buf, RoutineName)) return end if + if (allocated(OutData%iModPost)) deallocate(OutData%iModPost) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iModPost(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModPost.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModPost) + if (RegCheckErr(Buf, RoutineName)) return + end if end subroutine subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2415,6 +2459,7 @@ subroutine FAST_CopyTC_MiscVarType(SrcTC_MiscVarTypeData, DstTC_MiscVarTypeData, end if DstTC_MiscVarTypeData%UDiff = SrcTC_MiscVarTypeData%UDiff end if + DstTC_MiscVarTypeData%ConvWarn = SrcTC_MiscVarTypeData%ConvWarn if (allocated(SrcTC_MiscVarTypeData%Mappings)) then LB(1:1) = lbound(SrcTC_MiscVarTypeData%Mappings) UB(1:1) = ubound(SrcTC_MiscVarTypeData%Mappings) @@ -2665,6 +2710,7 @@ subroutine FAST_PackTC_MiscVarType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%UDiff), ubound(InData%UDiff)) call RegPack(Buf, InData%UDiff) end if + call RegPack(Buf, InData%ConvWarn) call RegPack(Buf, allocated(InData%Mappings)) if (allocated(InData%Mappings)) then call RegPackBounds(Buf, 1, lbound(InData%Mappings), ubound(InData%Mappings)) @@ -3042,6 +3088,8 @@ subroutine FAST_UnPackTC_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%UDiff) if (RegCheckErr(Buf, RoutineName)) return end if + call RegUnpack(Buf, OutData%ConvWarn) + if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%Mappings)) deallocate(OutData%Mappings) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 9ae9bba333..ecc6e7f3d8 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -61,13 +61,13 @@ subroutine Solver_Init(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Get array of module IDs modIDs = [(Mods(i)%ID, i=1, size(Mods))] - ! Indicies of all modules - p%iModAll = [pack(modInds, ModIDs == Module_SrvD), & - pack(modInds, ModIDs == Module_ED), & - pack(modInds, ModIDs == Module_BD), & - pack(modInds, ModIDs == Module_SD), & - pack(modInds, ModIDs == Module_IfW), & - pack(modInds, ModIDs == Module_AD)] + ! Indicies of all modules in Step 0 initialization order + p%iModInit = [pack(modInds, ModIDs == Module_ED), & + pack(modInds, ModIDs == Module_BD), & + pack(modInds, ModIDs == Module_SD), & + pack(modInds, ModIDs == Module_IfW), & + pack(modInds, ModIDs == Module_AD), & + pack(modInds, ModIDs == Module_SrvD)] ! ServoDyn is last ! Indicies of tight coupling modules p%iModTC = [pack(modInds, ModIDs == Module_ED), & @@ -101,6 +101,11 @@ subroutine Solver_Init(p, m, Mods, Turbine, ErrStat, ErrMsg) pack(modInds, ModIDs == Module_HD), & pack(modInds, ModIDs == Module_Orca)] + ! Indices of modules to perform InputSolves after the Option 1 solve + p%iModPost = [pack(modInds, ModIDs == Module_SrvD), & + pack(modInds, ModIDs == Module_MD), & + pack(modInds, ModIDs == Module_OpFM)] + ! Indices of BeamDyn modules p%iModBD = [pack(modInds, ModIDs == Module_BD)] @@ -250,7 +255,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, associate (Mod => Mods(p%iModTC(i))) do j = 1, size(Mod%Vars%x) if (Mod%Vars%x(j)%DerivOrder == 0) then - Mod%Vars%x(j)%iGblSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] + Mod%Vars%x(j)%iSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] NumX = NumX + Mod%Vars%x(j)%Num end if end do @@ -265,7 +270,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, associate (Mod => Mods(p%iModTC(i))) do j = 1, size(Mod%Vars%x) if (Mod%Vars%x(j)%DerivOrder == 1) then - Mod%Vars%x(j)%iGblSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] + Mod%Vars%x(j)%iSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] NumX = NumX + Mod%Vars%x(j)%Num end if end do @@ -281,7 +286,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, associate (Mod => Mods(p%iModTC(i))) do j = 1, size(Mod%Vars%x) vec1 = [vec1, Mod%Vars%x(j)%iLoc] - vec2 = [vec2, Mod%Vars%x(j)%iGblSol] + vec2 = [vec2, Mod%Vars%x(j)%iSol] end do call AllocAry(Mod%ixs, 2, size(vec1), "Mod%ixs", ErrStat2, ErrMsg2); if (Failed()) return Mod%ixs(1, :) = vec1 @@ -304,8 +309,8 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do i = 1, size(p%iModTC) do j = 1, size(Mods(p%iModTC(i))%Vars%u) associate (Var => Mods(p%iModTC(i))%Vars%u(j)) - if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iGblSol = [(NumU + k, k=1, Var%Num)] + if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iSol = [(NumU + k, k=1, Var%Num)] NumU = NumU + Var%Num end if end associate @@ -319,8 +324,8 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do i = 1, size(p%iModOpt1) do j = 1, size(Mods(p%iModOpt1(i))%Vars%u) associate (Var => Mods(p%iModOpt1(i))%Vars%u(j)) - if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iGblSol = [(NumU + k, k=1, Var%Num)] + if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iSol = [(NumU + k, k=1, Var%Num)] NumU = NumU + Var%Num end if end associate @@ -334,12 +339,12 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do i = 1, size(Mods) allocate (vec1(0), vec2(0)) do j = 1, size(Mods(i)%Vars%u) - if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle + if (.not. allocated(Mods(i)%Vars%u(j)%iSol)) cycle vec1 = [vec1, Mods(i)%Vars%u(j)%iLoc] - vec2 = [vec2, Mods(i)%Vars%u(j)%iGblSol] + vec2 = [vec2, Mods(i)%Vars%u(j)%iSol] select case (Mods(i)%Vars%u(j)%Field) case (VF_Force, VF_Moment) - iuLoad = [iuLoad, Mods(i)%Vars%u(j)%iGblSol] + iuLoad = [iuLoad, Mods(i)%Vars%u(j)%iSol] end select end do call AllocAry(Mods(i)%ius, 2, size(vec1), "Mods(i)%ius", ErrStat2, ErrMsg2); if (Failed()) return @@ -359,8 +364,8 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do i = 1, size(p%iModTC) do j = 1, size(Mods(p%iModTC(i))%Vars%y) associate (Var => Mods(p%iModTC(i))%Vars%y(j)) - if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iGblSol = [(NumY + k, k=1, Var%Num)] + if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iSol = [(NumY + k, k=1, Var%Num)] NumY = NumY + Var%Num end if end associate @@ -374,8 +379,8 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do i = 1, size(p%iModOpt1) do j = 1, size(Mods(p%iModOpt1(i))%Vars%y) associate (Var => Mods(p%iModOpt1(i))%Vars%y(j)) - if ((.not. allocated(Var%iGblSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iGblSol = [(NumY + k, k=1, Var%Num)] + if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then + Var%iSol = [(NumY + k, k=1, Var%Num)] NumY = NumY + Var%Num end if end associate @@ -389,9 +394,9 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do i = 1, size(Mods) allocate (vec1(0), vec2(0)) do j = 1, size(Mods(i)%Vars%y) - if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle + if (.not. allocated(Mods(i)%Vars%y(j)%iSol)) cycle vec1 = [vec1, Mods(i)%Vars%y(j)%iLoc] - vec2 = [vec2, Mods(i)%Vars%y(j)%iGblSol] + vec2 = [vec2, Mods(i)%Vars%y(j)%iSol] end do call AllocAry(Mods(i)%iys, 2, size(vec1), "Mods(i)%iys", ErrStat2, ErrMsg2); if (Failed()) return Mods(i)%iys(1, :) = vec1 @@ -463,7 +468,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, do j = 1, size(Mods(i)%Vars%x) do k = 1, Mods(i)%Vars%x(j)%Num num = num + 1 - p%ixqd(:, num) = [Mods(i)%Vars%x(j)%iGblSol(k), Mods(i)%Vars%x(j)%iq(k), Mods(i)%Vars%x(j)%DerivOrder + 1] + p%ixqd(:, num) = [Mods(i)%Vars%x(j)%iSol(k), Mods(i)%Vars%x(j)%iq(k), Mods(i)%Vars%x(j)%DerivOrder + 1] end do end do @@ -531,10 +536,10 @@ pure function NeedWriteOutput(n_t_global, t_global, t_initial, n_DT_Out) result( end if end function -subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) +subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inout) :: m !< Misc variables - type(ModDataType), intent(in) :: ModData(:) !< Module data + type(ModDataType), intent(in) :: Mods(:) !< Module data type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -568,12 +573,15 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) end if + ! Set flag to warn about convergence errors + m%ConvWarn = .true. + !---------------------------------------------------------------------------- ! Calculate initial accelerations !---------------------------------------------------------------------------- ! Transfer initial state from modules to solver - call PackModuleStates(ModData(p%iModTC), STATE_CURR, Turbine, x=m%x) + call PackModuleStates(Mods(p%iModTC), STATE_CURR, Turbine, x=m%x) ! Transfer initial state to state q matrix call TransferXtoQ(p%ixqd, m%x, m%qn) @@ -593,16 +601,16 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) do while ((.not. converged) .and. (k <= p%MaxConvIter)) ! Transfer inputs and calculate outputs for all modules (use current state) - do i = 1, size(p%iModAll) - call FAST_InputSolve(ModData(p%iModAll(i)), m%Mappings, IS_Input, & + do i = 1, size(p%iModInit) + call FAST_InputSolve(Mods(p%iModInit(i)), m%Mappings, IS_Input, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return - call FAST_CalcOutput(ModData(p%iModAll(i)), m%Mappings, t_initial, STATE_CURR, & + call FAST_CalcOutput(Mods(p%iModInit(i)), m%Mappings, t_initial, STATE_CURR, & Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do ! Calculate continuous state derivatives for tight coupling modules (use current state) do i = 1, size(p%iModTC) - call FAST_CalcContStateDeriv(ModData(p%iModTC(i)), t_initial, STATE_CURR, & + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_CURR, & Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return end do @@ -627,10 +635,8 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) end do ! Print warning if not converged - if (.not. converged) then - call WrScr("Solver: initial accel not converged, diff="//Num2LStr(diff)// & - ", tol="//Num2LStr(p%ConvTol)) - end if + if (.not. converged) call WrScr("Solver: initial accel not converged, diff="// & + trim(Num2LStr(diff))//", tol="//trim(Num2LStr(p%ConvTol))) ! Initialize algorithmic acceleration from actual acceleration m%qn(:, COL_AA) = m%qn(:, COL_A) @@ -640,15 +646,11 @@ subroutine Solver_Step0(p, m, ModData, Turbine, ErrStat, ErrMsg) ! Initialize module input and state arrays for interpolation/extrapolation !---------------------------------------------------------------------------- - ! Loop through all module index array - do i = 1, size(p%iModAll) - - ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) - call FAST_InitIO(ModData(p%iModAll(i)), t_initial, p%DT, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + ! Initialize IO and states for all modules (also copies STATE_CURR to STATE_PRED) + call FAST_InitIO(Mods, t_initial, p%DT, Turbine, ErrStat2, ErrMsg2); if (Failed()) return - ! Reset the Remap flags for all modules - call FAST_ResetRemapFlags(ModData(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return - end do + ! Reset the Remap flags for all modules + call FAST_ResetRemapFlags(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return contains logical function Failed() @@ -700,8 +702,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------------- ! Loop through all modules and extrap/interp inputs - do i = 1, size(p%iModAll) - call FAST_ExtrapInterp(Mods(p%iModAll(i)), t_global_next, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(Mods) + call FAST_ExtrapInterp(Mods(i), t_global_next, Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do !---------------------------------------------------------------------------- @@ -820,7 +822,17 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! If iteration limit reached, exit loop !---------------------------------------------------------------------- - if (iterConv >= p%MaxConvIter) exit + if (iterConv >= p%MaxConvIter) then + if (m%ConvWarn) then + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations on step "//trim(Num2LStr(n_t_global_next))// & + " (error="//trim(Num2LStr(delta_norm))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))// & + "). Warning will not be displayed again.", ErrStat, ErrMsg, RoutineName) + m%ConvWarn = .false. + end if + exit + end if !---------------------------------------------------------------------- ! Update Jacobian @@ -933,11 +945,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM iterCorr = iterCorr + 1 - ! Reset the remap flags on the meshes - do i = 1, size(p%iModAll) - call FAST_ResetRemapFlags(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + ! Perform input solve for modules post Option 1 + do i = 1, size(p%iModPost) + call FAST_InputSolve(Mods(p%iModPost(i)), m%Mappings, IS_Input, Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do + ! Reset mesh remap + call FAST_ResetRemapFlags(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do !---------------------------------------------------------------------------- @@ -957,11 +971,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do j = 1, size(p_BD%Vars%x) select case (p_BD%Vars%x(j)%Field) case (VF_TransDisp) - os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_A) - os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) + os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_A) + os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) case (VF_Orientation) - os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_A) - os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) + os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_A) + os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) end select end do @@ -972,11 +986,11 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM do j = 1, size(p_BD%Vars%x) select case (p_BD%Vars%x(j)%Field) case (VF_TransDisp) - m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) - m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) + m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) + m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) case (VF_Orientation) - m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) - m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) + m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) + m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) end select end do @@ -990,8 +1004,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call TransferXtoQ(p%ixqd, m%xn, m%qn) ! Copy the final predicted states from step t_global_next to actual states for that step - do i = 1, size(p%iModAll) - call FAST_SaveStates(Mods(p%iModAll(i)), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(Mods) + call FAST_SaveStates(Mods(i), Turbine, ErrStat2, ErrMsg2); if (Failed()) return end do ! Save new state @@ -1142,29 +1156,25 @@ subroutine AddDeltaToStates(Mods, ModOrder, dx, x) character(*), parameter :: RoutineName = 'AddDeltaToStates' integer(IntKi) :: iMod, iIns integer(IntKi) :: i, j, k, ind(3) - real(R8Ki) :: n(3), phi - ! Loop through modules in order + ! Loop through module variables based on order array do i = 1, size(ModOrder) - - ! Loop through variables do j = 1, size(Mods(ModOrder(i))%Vars%x) - associate (Var => Mods(ModOrder(i))%Vars%x(j)) ! Select based on field type select case (Var%Field) case (VF_Force, VF_Moment, VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) ! Add delta x to x - x(Var%iGblSol) = x(Var%iGblSol) + dx(Var%iGblSol) + x(Var%iSol) = x(Var%iSol) + dx(Var%iSol) case (VF_AngularDisp) ! Add delta x to x and limit to between -2pi and 2pi - ! x(ModData(i)%Vars%x(j)%iGblSol) = mod(x(ModData(i)%Vars%x(j)%iGblSol) + dx(ModData(i)%Vars%x(j)%iGblSol), TwoPi_R8) - x(Var%iGblSol) = x(Var%iGblSol) + dx(Var%iGblSol) + ! x(ModData(i)%Vars%x(j)%iSol) = mod(x(ModData(i)%Vars%x(j)%iSol) + dx(ModData(i)%Vars%x(j)%iSol), TwoPi_R8) + x(Var%iSol) = x(Var%iSol) + dx(Var%iSol) case (VF_Orientation) ! Compose WM components (dx is in radians) - do k = 1, size(Var%iGblSol), 3 - ind = Var%iGblSol(k:k + 2) + do k = 1, size(Var%iSol), 3 + ind = Var%iSol(k:k + 2) x(ind) = wm_compose(wm_from_xyz(dx(ind)), x(ind)) ! dx is in radians end do end select @@ -1198,15 +1208,15 @@ subroutine AddDeltaToInputs(Mods, ModOrder, du, u) select case (Var%Field) case (VF_Force, VF_Moment, VF_TransDisp, VF_TransVel, VF_TransAcc, VF_AngularVel, VF_AngularAcc) ! Add delta u to u - u(Var%iGblSol) = u(Var%iGblSol) + du(Var%iGblSol) + u(Var%iSol) = u(Var%iSol) + du(Var%iSol) case (VF_AngularDisp) ! Add delta u to u and limit to between -2pi and 2pi - ! un(Var%iGblSol) = mod(u(Var%iGblSol) + du(Var%iGblSol), TwoPi_R8) - u(Var%iGblSol) = u(Var%iGblSol) + du(Var%iGblSol) + ! un(Var%iSol) = mod(u(Var%iSol) + du(Var%iSol), TwoPi_R8) + u(Var%iSol) = u(Var%iSol) + du(Var%iSol) case (VF_Orientation) ! Compose WM components (change in orientation with orientation) - do k = 1, size(Var%iGblSol), 3 - ind = Var%iGblSol(k:k + 2) + do k = 1, size(Var%iSol), 3 + ind = Var%iSol(k:k + 2) u(ind) = wm_compose(wm_from_xyz(du(ind)), u(ind)) end do end select @@ -1233,7 +1243,7 @@ subroutine ComputeDeltaU(Mods, ModOrder, PosAry, NegAry, DiffAry) associate (Var => Mods(ModOrder(i))%Vars%u(j)) - if (.not. allocated(Var%iGblSol)) cycle + if (.not. allocated(Var%iSol)) cycle ! If variable field is orientation if (Var%Field == VF_Orientation) then @@ -1242,7 +1252,7 @@ subroutine ComputeDeltaU(Mods, ModOrder, PosAry, NegAry, DiffAry) do k = 1, Var%Nodes, 3 ! Get vector of indicies of WM rotation parameters in array - ind = Var%iGblSol(k:k + 2) + ind = Var%iSol(k:k + 2) ! Compose WM parameters to go from negative to positive array ! then store change in radians @@ -1252,7 +1262,7 @@ subroutine ComputeDeltaU(Mods, ModOrder, PosAry, NegAry, DiffAry) else ! Subtract negative array from positive array - DiffAry(Var%iGblSol) = PosAry(Var%iGblSol) - NegAry(Var%iGblSol) + DiffAry(Var%iSol) = PosAry(Var%iSol) - NegAry(Var%iSol) end if end associate end do @@ -1418,25 +1428,26 @@ subroutine Solver_Init_Debug(p, m, Mods) write (DebugUn, *) "Module = ", Mods(i)%Abbr write (DebugUn, *) "ModuleID = ", Mods(i)%ID do j = 1, size(Mods(i)%Vars%x) - if (.not. allocated(Mods(i)%Vars%x(j)%iGblSol)) cycle + if (.not. allocated(Mods(i)%Vars%x(j)%iSol)) cycle write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" X "//trim(Mods(i)%Vars%x(j)%Name)// & " ("//trim(MV_FieldString(Mods(i)%Vars%x(j)%Field))//")" - write (DebugUn, '(A,*(I6))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc - write (DebugUn, '(A,*(I6))') " X iGblSol = ", Mods(i)%Vars%x(j)%iGblSol + write (DebugUn, '(A,*(I6))') " X iLoc = ", Mods(i)%Vars%x(j)%iLoc + write (DebugUn, '(A,*(I6))') " X iSol = ", Mods(i)%Vars%x(j)%iSol + if (allocated(Mods(i)%Vars%x(j)%iq)) write (DebugUn, '(A,*(I6))') " X iq = ", Mods(i)%Vars%x(j)%iSol end do do j = 1, size(Mods(i)%Vars%u) - if (.not. allocated(Mods(i)%Vars%u(j)%iGblSol)) cycle + if (.not. allocated(Mods(i)%Vars%u(j)%iSol)) cycle write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" U "//trim(Mods(i)%Vars%u(j)%Name)// & " ("//trim(MV_FieldString(Mods(i)%Vars%u(j)%Field))//")" - write (DebugUn, '(A,*(I6))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc - write (DebugUn, '(A,*(I6))') " U iGblSol = ", Mods(i)%Vars%u(j)%iGblSol + write (DebugUn, '(A,*(I6))') " U iLoc = ", Mods(i)%Vars%u(j)%iLoc + write (DebugUn, '(A,*(I6))') " U iSol = ", Mods(i)%Vars%u(j)%iSol end do do j = 1, size(Mods(i)%Vars%y) - if (.not. allocated(Mods(i)%Vars%y(j)%iGblSol)) cycle + if (.not. allocated(Mods(i)%Vars%y(j)%iSol)) cycle write (DebugUn, *) "Var = "//trim(Mods(i)%Abbr)//trim(Num2LStr(Mods(i)%Ins))//" Y "//trim(Mods(i)%Vars%y(j)%Name)// & " ("//trim(MV_FieldString(Mods(i)%Vars%y(j)%Field))//")" - write (DebugUn, '(A,*(I6))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc - write (DebugUn, '(A,*(I6))') " Y iGblSol = ", Mods(i)%Vars%y(j)%iGblSol + write (DebugUn, '(A,*(I6))') " Y iLoc = ", Mods(i)%Vars%y(j)%iLoc + write (DebugUn, '(A,*(I6))') " Y iSol = ", Mods(i)%Vars%y(j)%iSol end do end do @@ -1446,7 +1457,8 @@ subroutine Solver_Init_Debug(p, m, Mods) write (DebugUn, *) "Mapping = "//m%Mappings(i)%Key write (DebugUn, *) " Src = "//trim(SrcMod%Abbr)//' Ins:'//trim(num2lstr(SrcMod%Ins))//' ModIdx:'//trim(num2lstr(SrcMod%Idx)) write (DebugUn, *) " Dst = "//trim(DstMod%Abbr)//' Ins:'//trim(num2lstr(DstMod%Ins))//' ModIdx:'//trim(num2lstr(DstMod%Idx)) - if (m%Mappings(i)%Idx /= 0) write (DebugUn, *) " Idx = "//trim(num2lstr(m%Mappings(i)%Idx)) + if (m%Mappings(i)%i1 /= 0) write (DebugUn, *) " i1 = "//trim(num2lstr(m%Mappings(i)%i1)) + if (m%Mappings(i)%i2 /= 0) write (DebugUn, *) " i2 = "//trim(num2lstr(m%Mappings(i)%i2)) end associate end do end subroutine diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index a5e683526f..14d1f3be09 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -586,6 +586,11 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%CouplingScheme = ExplicitLoose END IF + !............................................................................................ + ! Initialize module variables + !............................................................................................ + call ModuleVars_Init( InitInp, u, p, y, m, InitOut, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !............................................................................................ ! Close summary file: @@ -616,6 +621,102 @@ subroutine Cleanup() ! Ignore any errors here end subroutine Cleanup END SUBROUTINE SrvD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes module variables for use by the solver and linearization. +subroutine ModuleVars_Init(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(SrvD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SrvD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(SrvD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'ModuleVars_Init' + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + integer(IntKi) :: i, j, k + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + ! if (.not. InitInp%Linearize) return + ! TODO: Use modvars for linearization + return + + ! State Variables + call AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + InitOut%DerivOrder_x = 2 + do i = 1, size(p%Vars%x) + do j = 1, p%Vars%x(i)%Num + InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames + InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 + end do + end do + + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%Num + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + call AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%Num + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 + end do + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Initialize everything needed for linearization subroutine SrvD_Init_Jacobian( InitInp, p, u, y, InitOut, ErrStat, ErrMsg ) From 0a4495d3e6abe95a708dc1cfd014f4bc713faece Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Sep 2023 17:06:04 +0000 Subject: [PATCH 47/61] Fix error handling in FAST_Subs --- modules/openfast-library/src/FAST_Subs_TC.f90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index e8fdc4861a..e13be88cea 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -4883,12 +4883,20 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'FAST_Solution_T' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 real(dbki) :: t_global_next t_global_next = t_initial + (n_t_global+1)*Turbine%p_FAST%DT + ErrStat = ErrID_None + ErrMsg = '' + ! Get initial conditions for solver - CALL Solver_Step(n_t_global, t_initial, Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat, ErrMsg) - if (ErrStat >= AbortErrLev) return + CALL Solver_Step(n_t_global, t_initial, Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return ! CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & @@ -4898,7 +4906,8 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CALL WriteOutputToFile(n_t_global + 1, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SeaSt, Turbine%HD, Turbine%SD, & Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_Solution_T !---------------------------------------------------------------------------------------------------------------------------------- From c6a0906f6bdd643690ab9d71c24c043ae2a2ca9c Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Sep 2023 17:06:37 +0000 Subject: [PATCH 48/61] Add ModVars to SubDyn Registry, clean BD Registry --- modules/beamdyn/src/BeamDyn_Types.f90 | 60 +++++++-------- modules/beamdyn/src/Registry_BeamDyn.txt | 2 +- modules/subdyn/src/SubDyn_Registry.txt | 3 + modules/subdyn/src/SubDyn_Types.f90 | 93 ++++++++++++++++++++++++ 4 files changed, 127 insertions(+), 31 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 9f9c0d5b37..dc4e343e36 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -60,6 +60,7 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key points [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] @@ -70,7 +71,6 @@ MODULE BeamDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] - TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] END TYPE BD_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -458,6 +458,7 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%kp_coordinate)) then LB(1:2) = lbound(SrcInitOutputData%kp_coordinate) UB(1:2) = ubound(SrcInitOutputData%kp_coordinate) @@ -567,7 +568,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if - DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -587,6 +587,7 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%kp_coordinate)) then deallocate(InitOutputData%kp_coordinate) end if @@ -614,7 +615,6 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%DerivOrder_x)) then deallocate(InitOutputData%DerivOrder_x) end if - nullify(InitOutputData%Vars) end subroutine subroutine BD_PackInitOutput(Buf, Indata) @@ -634,6 +634,13 @@ subroutine BD_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if 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)) @@ -680,13 +687,6 @@ subroutine BD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if - call RegPack(Buf, associated(InData%Vars)) - if (associated(InData%Vars)) then - call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) - if (.not. PtrInIndex) then - call NWTC_Library_PackModVarsType(Buf, InData%Vars) - end if - end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -729,6 +729,26 @@ subroutine BD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -857,26 +877,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%Vars)) deallocate(OutData%Vars) - 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%Vars) - else - allocate(OutData%Vars,stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) - call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars - end if - else - OutData%Vars => null() - end if end subroutine subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index d48b5b7651..d15a887a7a 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -41,6 +41,7 @@ typedef ^ InitInputType Logical DynamicSolve - .TRUE. - "Use d typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" typedef ^ InitOutputType R8Ki kp_coordinate {:}{:} - - "Key point coordinates array" - typedef ^ InitOutputType IntKi kp_total - - - "Total number of key points" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - @@ -53,7 +54,6 @@ typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - -typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # ..... Blade Input file data........................................................................ typedef ^ BladeInputData IntKi station_total - - - "Number of blade input stations" diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 0287f2ab96..56fa2adc9b 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -59,6 +59,7 @@ typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" # Linearization typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -137,6 +138,7 @@ typedef ^ ^ IntKi n - - - "tracks # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. +typedef ^ MiscVarType ModValsType Vals - - - "Values corresponding to module variables" typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" typedef ^ MiscVarType ReKi u_TP 6 - - typedef ^ MiscVarType ReKi udot_TP 6 - - @@ -170,6 +172,7 @@ typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermedia ### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### # ============================== Parameters ============================================================================================================================================ +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" # --- Parameters - Algo typedef ^ ParameterType DbKi SDDeltaT - - - "Time step (for integration of continuous states)" seconds typedef ^ ParameterType IntKi IntMethod - - - "Integration Method (1/2/3)Length of y2 array" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 96a79aae0c..58b7e866db 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -98,6 +98,7 @@ MODULE SubDyn_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 [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -188,6 +189,7 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_MiscVarType ======= TYPE, PUBLIC :: SD_MiscVarType + TYPE(ModValsType) :: Vals !< Values corresponding to module variables [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi @@ -221,6 +223,7 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -1193,6 +1196,7 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y) UB(1:1) = ubound(SrcInitOutputData%LinNames_y) @@ -1320,6 +1324,7 @@ subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1353,6 +1358,7 @@ subroutine SD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitOutput' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then @@ -1365,6 +1371,13 @@ subroutine SD_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) @@ -1420,6 +1433,8 @@ subroutine SD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) @@ -1450,6 +1465,26 @@ subroutine SD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2898,9 +2933,13 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%qmdotdot)) then LB(1:1) = lbound(SrcMiscData%qmdotdot) UB(1:1) = ubound(SrcMiscData%qmdotdot) @@ -3200,9 +3239,13 @@ subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(SD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%qmdotdot)) then deallocate(MiscData%qmdotdot) end if @@ -3282,6 +3325,7 @@ subroutine SD_PackMisc(Buf, Indata) type(SD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackMisc' if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModValsType(Buf, InData%Vals) call RegPack(Buf, allocated(InData%qmdotdot)) if (allocated(InData%qmdotdot)) then call RegPackBounds(Buf, 1, lbound(InData%qmdotdot), ubound(InData%qmdotdot)) @@ -3418,6 +3462,7 @@ subroutine SD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals if (allocated(OutData%qmdotdot)) deallocate(OutData%qmdotdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3779,6 +3824,18 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%SDDeltaT = SrcParamData%SDDeltaT DstParamData%IntMethod = SrcParamData%IntMethod DstParamData%nDOF = SrcParamData%nDOF @@ -4572,6 +4629,12 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%Elems)) then deallocate(ParamData%Elems) end if @@ -4799,7 +4862,15 @@ subroutine SD_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackParam' integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, InData%SDDeltaT) call RegPack(Buf, InData%IntMethod) call RegPack(Buf, InData%nDOF) @@ -5178,7 +5249,29 @@ subroutine SD_UnPackParam(Buf, OutData) integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(Buf, OutData%SDDeltaT) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%IntMethod) From cc5b1c7183ccf3fa1337fa361c171826329a4c41 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Sep 2023 17:07:03 +0000 Subject: [PATCH 49/61] Add ModVars placeholder in SubDyn --- modules/subdyn/src/SubDyn.f90 | 102 ++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 1258379d05..1387a3a0d7 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -389,6 +389,9 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO if (InitInput%Linearize) then call SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat2, ErrMsg2); if(Failed()) return endif + + ! Initialize module variables + call Init_ModuleVars(InitInput, u, p, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return ! Tell GLUECODE the SubDyn timestep interval Interval = p%SDdeltaT @@ -413,6 +416,105 @@ END SUBROUTINE CleanUp END SUBROUTINE SD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> Init_ModuleVars initializes the variables for this module for use by the solver and linearization +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) + TYPE(SD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(SD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j, flags + REAL(R8Ki) :: MaxThrust, MaxTorque + CHARACTER(200) :: Describe + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Add pointers to vars to inititialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + ! if (.not. InitInp%Linearize) return + ! TODO: Use variables for linearization + return + + ! State Variables + call AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + InitOut%DerivOrder_x = 2 + do i = 1, size(p%Vars%x) + do j = 1, p%Vars%x(i)%Num + InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames + InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 + end do + end do + + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, p%Vars%Nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%Num + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%RotFrame_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Flags, VF_RotFrame) > 0 + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + call AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_y, p%Vars%Ny, 'RotFrame_y', ErrStat2, ErrMsg2); if (Failed()) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%Num + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + InitOut%RotFrame_y(p%Vars%y(i)%iLoc) = iand(p%Vars%y(i)%Flags, VF_RotFrame) > 0 + end do + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. !! Continuous, discrete, constraint, and other states are updated for t + Interval. From 2796ae3f948400d326a9c0468c68dd23e2e30fb2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Sep 2023 17:07:43 +0000 Subject: [PATCH 50/61] Move BD update ref into FAST_UpdateStates, cleanup --- modules/openfast-library/src/FAST_Eval.f90 | 163 ++++++++++++++------- modules/openfast-library/src/Solver.f90 | 58 ++------ 2 files changed, 121 insertions(+), 100 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 4a0d1b279e..26f9d5ab51 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -301,30 +301,77 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, T%AD%p, T%AD%x(STATE_PRED), & - T%AD%xd(STATE_PRED), T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), T%AD%m, ErrStat2, ErrMsg2); if (Failed()) return + call AD_UpdateStates(t_module, n_t_module, T%AD%Input, T%AD%InputTimes, & + T%AD%p, T%AD%x(STATE_PRED), T%AD%xd(STATE_PRED), & + T%AD%z(STATE_PRED), T%AD%OtherSt(STATE_PRED), & + T%AD%m, ErrStat2, ErrMsg2) + if (Failed()) return end do case (Module_BD) - ! Transfer tight coupling states to module - call BD_PackStateValues(T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, STATE_PRED), T%BD%m(ModData%Ins)%Vals%x) - call XferGblToLoc1D(ModData%ixs, x_TC, T%BD%m(ModData%Ins)%Vals%x) - call BD_UnpackStateValues(T%BD%p(ModData%Ins), T%BD%m(ModData%Ins)%Vals%x, T%BD%x(ModData%Ins, STATE_PRED)) + associate (p_BD => T%BD%p(ModData%Ins), & + m_BD => T%BD%m(ModData%Ins), & + u_BD => T%BD%Input(1, ModData%Ins), & + x_BD => T%BD%x(ModData%Ins, STATE_PRED), & + os_BD => T%BD%OtherSt(ModData%Ins, STATE_PRED)) + + ! Transfer tight coupling states to module + call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) + call XferGblToLoc1D(ModData%ixs, x_TC, m_BD%Vals%x) + call BD_UnpackStateValues(p_BD, m_BD%Vals%x, x_BD) + + ! Set BD accelerations and algorithmic accelerations from q matrix + do j = 1, size(p_BD%Vars%x) + select case (p_BD%Vars%x(j)%Field) + case (VF_TransDisp) + os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 3) + os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 4) + case (VF_Orientation) + os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 3) + os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 4) + end select + end do + + ! Update the global reference + call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg) + if (Failed()) return + + ! Update q matrix accelerations and algorithmic accelerations from BD + do j = 1, size(p_BD%Vars%x) + select case (p_BD%Vars%x(j)%Field) + case (VF_TransDisp) + q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) + q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) + case (VF_Orientation) + q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) + q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) + end select + end do + + ! Transfer updated states to solver + call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) + call XferLocToGbl1D(ModData%ixs, m_BD%Vals%x, x_TC) + end associate case (Module_ED) - ! Transfer tight coupling states to module - call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) - call XferGblToLoc1D(ModData%ixs, x_TC, T%ED%m%Vals%x) - call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(STATE_PRED)) + associate (p_ED => T%ED%p, m_ED => T%ED%m, & + u_ED => T%ED%Input(1), x_ED => T%ED%x(STATE_PRED)) + + ! Transfer tight coupling states to module + call ED_PackStateValues(p_ED, x_ED, m_ED%Vals%x) + call XferGblToLoc1D(ModData%ixs, x_TC, m_ED%Vals%x) + call ED_UnpackStateValues(p_ED, m_ED%Vals%x, x_ED) - ! Update the azimuth angle - call ED_UpdateAzimuth(T%ED%p, T%ED%x(STATE_PRED), T%p_FAST%DT) + ! Update the azimuth angle + call ED_UpdateAzimuth(p_ED, x_ED, T%p_FAST%DT) - ! Transfer updated states to solver - call ED_PackStateValues(T%ED%p, T%ED%x(STATE_PRED), T%ED%m%Vals%x) - call XferLocToGbl1D(ModData%ixs, T%ED%m%Vals%x, x_TC) + ! Transfer updated states to solver + call ED_PackStateValues(p_ED, x_ED, m_ED%Vals%x) + call XferLocToGbl1D(ModData%ixs, m_ED%Vals%x, x_TC) + + end associate ! case (Module_ExtPtfm) ! case (Module_FEAM) @@ -333,8 +380,11 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input, T%HD%InputTimes, T%HD%p, T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & - T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), T%HD%m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_UpdateStates(t_module, n_t_module, T%HD%Input, T%HD%InputTimes, T%HD%p, & + T%HD%x(STATE_PRED), T%HD%xd(STATE_PRED), & + T%HD%z(STATE_PRED), T%HD%OtherSt(STATE_PRED), & + T%HD%m, ErrStat2, ErrMsg2) + if (Failed()) return end do ! case (Module_IceD) @@ -344,8 +394,11 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & - T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return + call InflowWind_UpdateStates(t_module, n_t_module, T%IfW%Input, T%IfW%InputTimes, T%IfW%p, & + T%IfW%x(STATE_PRED), T%IfW%xd(STATE_PRED), & + T%IfW%z(STATE_PRED), T%IfW%OtherSt(STATE_PRED), & + T%IfW%m, ErrStat2, ErrMsg2) + if (Failed()) return end do ! case (Module_MAP) @@ -354,12 +407,15 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS ! case (Module_Orca) case (Module_SD) - do j_ss = 1, ModData%SubSteps - n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 - t_module = n_t_module*ModData%DT + t_initial - call SD_UpdateStates(t_module, n_t_module, T%SD%Input, T%SD%InputTimes, T%SD%p, T%SD%x(STATE_PRED), & - T%SD%xd(STATE_PRED), T%SD%z(STATE_PRED), T%SD%OtherSt(STATE_PRED), T%SD%m, ErrStat2, ErrMsg2); if (Failed()) return - end do + associate (p_SD => T%SD%p, m_SD => T%SD%m, & + u_SD => T%SD%Input(1), x_SD => T%SD%x(STATE_PRED)) + + ! Transfer tight coupling states to module + ! call SD_PackStateValues(p_SD, x_SD, m_SD%Vals%x) + ! call XferGblToLoc1D(ModData%ixs, x_TC, m_SD%Vals%x) + ! call SD_UnpackStateValues(p_SD, m_SD%Vals%x, x_SD) + + end associate ! case (Module_SeaSt) case (Module_SrvD) @@ -367,8 +423,11 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS do j_ss = 1, ModData%SubSteps n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 t_module = n_t_module*ModData%DT + t_initial - call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & - T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return + call SrvD_UpdateStates(t_module, n_t_module, T%SrvD%Input, T%SrvD%InputTimes, T%SrvD%p, & + T%SrvD%x(STATE_PRED), T%SrvD%xd(STATE_PRED), & + T%SrvD%z(STATE_PRED), T%SrvD%OtherSt(STATE_PRED), & + T%SrvD%m, ErrStat2, ErrMsg2) + if (Failed()) return end do case default @@ -1026,7 +1085,7 @@ subroutine AD_InputSolve1(ModData, Maps, u_AD, T, ErrStat, ErrMsg) contains logical function Failed() - Failed = ErrStat2 >= AbortErrLev + Failed = ErrStat2 /= ErrID_None if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') end function end subroutine @@ -1084,7 +1143,7 @@ subroutine BD_InputSolve1(ModData, Maps, u_BD, T, ErrStat, ErrMsg) contains logical function Failed() - Failed = ErrStat2 >= AbortErrLev + Failed = ErrStat2 /= ErrID_None if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') end function end subroutine @@ -1259,7 +1318,7 @@ subroutine IfW_InputSolve1(ModData, Maps, u_IfW, T, ErrStat, ErrMsg) contains logical function Failed() - Failed = ErrStat2 >= AbortErrLev + Failed = ErrStat2 /= ErrID_None if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') end function end subroutine @@ -1374,7 +1433,7 @@ subroutine SrvD_InputSolve1(ModData, Maps, u_SrvD, T, ErrStat, ErrMsg) contains logical function Failed() - Failed = ErrStat2 >= AbortErrLev + Failed = ErrStat2 /= ErrID_None if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') end function end subroutine @@ -1464,10 +1523,11 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcContStateDeriv(ModData, this_time, this_state, T, ErrStat, ErrMsg, dxdt) +subroutine FAST_CalcContStateDeriv(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, ErrMsg, dxdt) type(ModDataType), intent(in) :: ModData !< Module data - real(DbKi), intent(in) :: this_time !< Time - integer(IntKi), intent(in) :: this_state !< State index + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State index + logical, intent(in) :: IsSolve !< Calculate solver derivs, otherwise linearization type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1487,8 +1547,8 @@ subroutine FAST_CalcContStateDeriv(ModData, this_time, this_state, T, ErrStat, E case (Module_BD) - call BD_CalcContStateDeriv(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), & - T%BD%xd(ModData%Ins, this_state), T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), & + call BD_CalcContStateDeriv(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), & + T%BD%xd(ModData%Ins, ThisState), T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & T%BD%m(ModData%Ins), T%BD%dxdt(ModData%Ins), ErrStat2, ErrMsg2); if (Failed()) return if (present(dxdt)) then call BD_PackStateValues(T%BD%p(ModData%Ins), T%BD%dxdt(ModData%Ins), T%BD%m(ModData%Ins)%Vals%dxdt) @@ -1497,8 +1557,8 @@ subroutine FAST_CalcContStateDeriv(ModData, this_time, this_state, T, ErrStat, E case (Module_ED) - call ED_CalcContStateDeriv(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%m, & + call ED_CalcContStateDeriv(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%m, & T%ED%dxdt, ErrStat2, ErrMsg2); if (Failed()) return if (present(dxdt)) then call ED_PackStateValues(T%ED%p, T%ED%dxdt, T%ED%m%Vals%dxdt) @@ -1530,19 +1590,20 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcJacobian(ModData, this_time, this_state, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) +subroutine FAST_CalcJacobian(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) type(ModDataType), intent(in) :: ModData !< Module data - real(DbKi), intent(in) :: this_time !< Time - integer(IntKi), intent(in) :: this_state !< State + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State type(FAST_TurbineType), intent(inout) :: T !< Turbine type + logical, intent(in) :: IsSolve !< Calculate solver Jacobians, otherwise linearization integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) - character(*), parameter :: RoutineName = 'FAST_CalcContStateDeriv' + character(*), parameter :: RoutineName = 'FAST_CalcJacobian' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: j_ss ! substep loop counter ErrStat = ErrID_None ErrMsg = '' @@ -1554,28 +1615,28 @@ subroutine FAST_CalcJacobian(ModData, this_time, this_state, T, ErrStat, ErrMsg, case (Module_BD) - call BD_JacobianPInput(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), T%BD%xd(ModData%Ins, this_state), & - T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & + call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & ErrStat2, ErrMsg2, dYdu=T%BD%m(ModData%Ins)%Vals%dYdu, dXdu=T%BD%m(ModData%Ins)%Vals%dXdu); if (Failed()) return if (present(dYdu)) call XferLocToGbl2D(ModData%iys, ModData%ius, T%BD%m(ModData%Ins)%Vals%dYdu, dYdu) if (present(dXdu)) call XferLocToGbl2D(ModData%ixs, ModData%ius, T%BD%m(ModData%Ins)%Vals%dXdu, dXdu) - call BD_JacobianPContState(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), T%BD%xd(ModData%Ins, this_state), & - T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & + call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & ErrStat2, ErrMsg2, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return if (present(dYdx)) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) if (present(dXdx)) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) case (Module_ED) - call ED_JacobianPInput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return if (present(dYdu)) call XferLocToGbl2D(ModData%iys, ModData%ius, T%ED%m%Vals%dYdu, dYdu) if (present(dXdu)) call XferLocToGbl2D(ModData%ixs, ModData%ius, T%ED%m%Vals%dXdu, dXdu) - call ED_JacobianPContState(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, & + call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return if (present(dYdx)) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) if (present(dXdx)) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index ecc6e7f3d8..5cbe05eb66 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -547,6 +547,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Solver_Step0' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + logical, parameter :: IsSolve = .true. integer(IntKi) :: i, j, k real(R8Ki), allocatable :: accel(:) real(R8Ki) :: diff @@ -610,7 +611,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Calculate continuous state derivatives for tight coupling modules (use current state) do i = 1, size(p%iModTC) - call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_CURR, & + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_CURR, IsSolve, & Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return end do @@ -664,7 +665,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM real(DbKi), intent(in) :: t_initial !< Initial simulation time type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inout) :: m !< Misc variables - type(ModDataType), intent(in) :: Mods(:) !< Module data + type(ModDataType), intent(in) :: Mods(:) !< Module data type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -672,9 +673,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM character(*), parameter :: RoutineName = 'Solver_Step' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: NumCorrections ! number of corrections for this time step + logical, parameter :: IsSolve = .true. integer(IntKi) :: iterConv, iterCorr - logical :: update_jacobian real(ReKi) :: delta_norm real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 @@ -853,7 +853,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Calculate continuous state derivatives for tight coupling modules do i = 1, size(p%iModTC) - call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_global_next, STATE_PRED, & + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_global_next, STATE_PRED, IsSolve, & Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt) if (Failed()) return end do @@ -889,6 +889,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Check perturbations for convergence and exit if below tolerance !---------------------------------------------------------------------- + ! Calculate average L2 norm of change in states and inputs delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) if (DebugSolver) then @@ -958,48 +959,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Update states for next step !---------------------------------------------------------------------------- - ! Loop through BeamDyn instances - do i = 1, size(p%iModBD) - associate (Mod => Mods(p%iModBD(i)), & - p_BD => Turbine%BD%p(Mods(p%iModBD(i))%Ins), & - m_BD => Turbine%BD%m(Mods(p%iModBD(i))%Ins), & - u_BD => Turbine%BD%Input(1, Mods(p%iModBD(i))%Ins), & - x_BD => Turbine%BD%x(Mods(p%iModBD(i))%Ins, STATE_PRED), & - os_BD => Turbine%BD%OtherSt(Mods(p%iModBD(i))%Ins, STATE_PRED)) - - ! Update accelerations and algorithmic accelerations - do j = 1, size(p_BD%Vars%x) - select case (p_BD%Vars%x(j)%Field) - case (VF_TransDisp) - os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_A) - os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) - case (VF_Orientation) - os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_A) - os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) = m%qn(p_BD%Vars%x(j)%iq, COL_AA) - end select - end do - - ! Update the global reference - call BD_UpdateGlobalRef(u_BD, p_BD, x_BD, os_BD, ErrStat, ErrMsg); if (Failed()) return - - ! Update accelerations and algorithmic accelerations - do j = 1, size(p_BD%Vars%x) - select case (p_BD%Vars%x(j)%Field) - case (VF_TransDisp) - m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) - m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) - case (VF_Orientation) - m%qn(p_BD%Vars%x(j)%iq, COL_A) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) - m%qn(p_BD%Vars%x(j)%iq, COL_AA) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) - end select - end do - - ! Transfer updated states to solver - call BD_PackStateValues(p_BD, x_BD, m_BD%Vals%x) - call XferLocToGbl1D(Mod%ixs, m_BD%Vals%x, m%xn) - end associate - end do - ! Update state matrix from state array call TransferXtoQ(p%ixqd, m%xn, m%qn) @@ -1045,6 +1004,7 @@ subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BuildJacobian' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + logical, parameter :: IsSolve = .true. integer(IntKi) :: i, j real(R8Ki), allocatable :: tmp(:, :) real(R8Ki), dimension(3) :: wm_b, wm_p, wm_n, wm_d, wm_pert, delta @@ -1072,13 +1032,13 @@ subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) ! Calculate dYdx, dXdx, dXdu for tight coupling modules do i = 1, size(p%iModTC) - call FAST_CalcJacobian(Mods(p%iModTC(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_CalcJacobian(Mods(p%iModTC(i)), this_time, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, & dYdx=m%dYdx, dXdx=m%dXdx, dXdu=m%dXdu); if (Failed()) return end do ! Calculate dYdu Loop for Option 1 modules do i = 1, size(p%iModOpt1) - call FAST_CalcJacobian(Mods(p%iModOpt1(i)), this_time, STATE_PRED, Turbine, ErrStat2, ErrMsg2, & + call FAST_CalcJacobian(Mods(p%iModOpt1(i)), this_time, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, & dYdu=m%dYdu); if (Failed()) return end do From 21972640658186065639ae71e81bfb8ce27e7907 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 14 Sep 2023 21:57:54 +0000 Subject: [PATCH 51/61] Cleanup and automatic Jacobian recalc --- modules/beamdyn/src/BeamDyn.f90 | 241 ++++++++------- modules/elastodyn/src/ElastoDyn.f90 | 256 ++++++++-------- modules/nwtc-library/src/ModVar.f90 | 2 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 11 +- .../src/Registry_NWTC_Library.txt | 7 +- .../src/Registry_NWTC_Library_base.txt | 7 +- modules/openfast-library/src/FAST_Eval.f90 | 283 ++++++++++++------ modules/openfast-library/src/FAST_Subs_TC.f90 | 35 ++- modules/openfast-library/src/Solver.f90 | 157 ++++------ 9 files changed, 552 insertions(+), 447 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 9a8e88d384..27bf591e24 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -288,7 +288,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - integer(IntKi) :: i, j, flags + integer(IntKi) :: i, j, flags, idx REAL(R8Ki) :: MaxThrust, MaxTorque CHARACTER(200) :: Describe @@ -316,13 +316,15 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) do i = 2, p%node_total Describe = 'finite element node '//trim(num2lstr(i))//' (number of elements = '//& trim(num2lstr(p%elem_total))//'; element order = '//trim(num2lstr(p%nodes_per_elem-1))//')' - call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, Num=3, Flags=flags, & + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_TransDisp, Num=3, & + Flags=flags, & iUsr=i, & Perturb=0.2_BDKi*D2R_D * p%blade_length, & LinNames=[trim(Describe)//' translational displacement in X, m', & trim(Describe)//' translational displacement in Y, m', & trim(Describe)//' translational displacement in Z, m']) - call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, Num=3, Flags=flags, & + call MV_AddVar(p%Vars%x, "Blade Node "//trim(num2lstr(i)), VF_Orientation, Num=3, & + Flags=flags, & iUsr=i, & Perturb=0.2_BDKi*D2R_D, & LinNames=[trim(Describe)//' rotational displacement in X, rad', & @@ -384,13 +386,15 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) LinNames=[trim(p%OutParam(i)%Name)//', '//trim(p%OutParam(i)%Units)], & Active=p%OutParam(i)%Indx > 0) end do + idx = p%NumOuts + 1 do i = 1, p%BldNd_NumOuts - ! call MV_AddVar(p%Vars%y, 'Node'//p%BldNd_OutParam(i)%Name, VF_Scalar, & - ! Num=size(p%BldNd_BlOutNd), & - ! Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & - ! iUsr=[(j, j=1,size(p%BldNd_BlOutNd))] + p%NumOuts + (i-1)*size(p%BldNd_BlOutNd), & - ! LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & - ! Active=p%BldNd_OutParam(i)%Indx > 0) + call MV_AddVar(p%Vars%y, p%BldNd_OutParam(i)%Name, VF_Scalar, & + Num=size(p%BldNd_BlOutNd), & + Flags=BldNd_OutParamFlags(p%BldNd_OutParam(i)%Name), & + iUsr=idx, & + LinNames=[(BldNd_LinChan(p%BldNd_OutParam(i), j), j=1,size(p%BldNd_BlOutNd))], & + Active=p%BldNd_OutParam(i)%Indx > 0) + idx = idx + size(p%BldNd_BlOutNd) end do !---------------------------------------------------------------------------- @@ -478,6 +482,79 @@ logical function Failed() end function Failed end subroutine +subroutine BD_PackStateValues(p, x, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp) + Values(p%Vars%x(i)%iLoc) = x%q(1:3,p%Vars%x(i)%iUsr(1)) ! XYZ displacement + case (VF_TransVel) + Values(p%Vars%x(i)%iLoc) = x%dqdt(1:3,p%Vars%x(i)%iUsr(1)) ! XYZ velocity + case (VF_Orientation) + Values(p%Vars%x(i)%iLoc) = x%q(4:6,p%Vars%x(i)%iUsr(1)) ! WM parameters + case (VF_AngularVel) + Values(p%Vars%x(i)%iLoc) = x%dqdt(4:6,p%Vars%x(i)%iUsr(1)) ! Angular velocity + end select + end do +end subroutine + +subroutine BD_UnpackStateValues(p, Values, x) + type(BD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Values(:) + type(BD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp) + x%q(1:3,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! XYZ displacement + case (VF_TransVel) + x%dqdt(1:3,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! XYZ velocity + case (VF_Orientation) + x%q(4:6,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! WM parameters + case (VF_AngularVel) + x%dqdt(4:6,p%Vars%x(i)%iUsr(1)) = Values(p%Vars%x(i)%iLoc) ! Angular velocity + end select + end do +end subroutine + +subroutine BD_PackInputValues(p, u, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_InputType), intent(in) :: u + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: iv + iv = 1 + call MV_PackMesh(p%Vars%u, iv, u%RootMotion, Values) + call MV_PackMesh(p%Vars%u, iv, u%PointLoad, Values) + call MV_PackMesh(p%Vars%u, iv, u%DistrLoad, Values) +end subroutine + +subroutine BD_UnpackInputValues(p, Values, u) + type(BD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: Values(:) + type(BD_InputType), intent(inout) :: u + integer(IntKi) :: iv + iv = 1 + call MV_UnpackMesh(p%Vars%u, iv, Values, u%RootMotion) + call MV_UnpackMesh(p%Vars%u, iv, Values, u%PointLoad) + call MV_UnpackMesh(p%Vars%u, iv, Values, u%DistrLoad) +end subroutine + +subroutine BD_PackOutputValues(p, y, Values) + type(BD_ParameterType), intent(in) :: p + type(BD_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: Values(:) + integer(IntKi) :: iv + iv = 1 + call MV_PackMesh(p%Vars%y, iv, y%ReactionForce, Values) + call MV_PackMesh(p%Vars%y, iv, y%BldMotion, Values) + do while (iv <= size(p%Vars%y)) + call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr(1):p%Vars%y(iv)%iUsr(2)), Values) + end do +end subroutine + !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine computes the mass (p%Mass0_QP) and stiffness (p%Stif0_QP) matrices at the quadrature nodes. subroutine InitializeMassStiffnessMatrices(InputFileData,p,ErrStat, ErrMsg) @@ -5985,7 +6062,7 @@ END SUBROUTINE PitchActuator_SetBC !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, IsSolve) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6010,12 +6087,14 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] + LOGICAL, OPTIONAL, INTENT(IN) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables TYPE(BD_OutputType) :: y_p TYPE(BD_ContinuousStateType) :: x_p TYPE(BD_InputType) :: u_perturb INTEGER(IntKi) :: i, j, k REAL(R8Ki) :: RotateStates(3,3) + LOGICAL :: IsSolveLoc character(*), parameter :: RoutineName = 'BD_JacobianPInput' integer(intKi) :: ErrStat2 @@ -6024,6 +6103,12 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if ! get OP values here: call BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if (Failed()) return @@ -6048,12 +6133,8 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Loop through input variables do i = 1, size(p%Vars%u) - ! If variable is for extended linearization, skip - if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle - - ! If variable is for extended linearization, skip - ! TODO: Remove for linearization - if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -6090,12 +6171,8 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Loop through input variables do i = 1,size(p%Vars%u) - ! If extended linearization variable, skip - if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle - - ! If variable is for extended linearization, skip - ! TODO: Remove for linearization - if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -6150,7 +6227,7 @@ END SUBROUTINE BD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, StateRotation ) +SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, StateRotation, IsSolve ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6180,12 +6257,13 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! functions (Z) with respect to !! the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: StateRotation(:,:) !< Matrix by which the states are optionally rotated - + LOGICAL, OPTIONAL, INTENT(IN) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables ! local variables INTEGER(IntKi) :: i REAL(R8Ki) :: RotateStates(3,3) REAL(R8Ki) :: RotateStatesTranspose(3,3) + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6196,10 +6274,17 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrStat = ErrID_None ErrMsg = '' + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if + ! Calculate Jacobian without rotation - call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx); if (Failed()) return + call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx, IsSolveLoc); if (Failed()) return - if (p%RotStates) then + ! If states need to be rotated + if (.not. IsSolveLoc .and. p%RotStates) then RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) RotateStatesTranspose = transpose( RotateStates ) @@ -6209,14 +6294,6 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if StateRotation = RotateStates end if - else - if ( present(StateRotation) ) then - if (allocated(StateRotation)) deallocate(StateRotation) - end if - end if - - ! If states need to be rotated - if (p%RotStates) then ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: IF (PRESENT(dYdx)) THEN @@ -6235,8 +6312,11 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end do END IF + else if ( present(StateRotation) ) then + if (allocated(StateRotation)) deallocate(StateRotation) end if + IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) END IF @@ -6255,7 +6335,7 @@ END SUBROUTINE BD_JacobianPContState !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, and dX/dx are returned. !SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, calledFrom, ErrStat, ErrMsg, dYdx, dXdx ) -SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx ) +SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, IsSolve ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -6279,6 +6359,7 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state !! functions (X) with respect to !! the continuous states (x) [intent in to avoid deallocation] + LOGICAL, OPTIONAL, INTENT(IN) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables ! local variables @@ -6288,6 +6369,7 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, INTEGER(IntKi) :: i, j, k INTEGER(IntKi) :: index INTEGER(IntKi) :: dof + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6299,6 +6381,12 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat = ErrID_None ErrMsg = '' + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if + ! Pack operating point state values for perturbations call BD_PackStateValues(p, x, m%Vals%x) @@ -6319,8 +6407,8 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ! Loop through state variables do i = 1,size(p%Vars%x) - ! If variable is for extended linearization, skip - if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%x(i)%Num @@ -6356,9 +6444,9 @@ SUBROUTINE BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ! Loop through state variables do i = 1,size(p%Vars%x) - - ! If no-lin or extended linearization variable, skip - if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle + + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%x(i)%Num @@ -6821,78 +6909,5 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) end subroutine -subroutine BD_PackStateValues(p, x, Values) - type(BD_ParameterType), intent(in) :: p - type(BD_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: Values(:) - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (VF_TransDisp) - Values(p%Vars%x(i)%iLoc) = x%q(1:3,p%Vars%x(i)%iUsr) ! XYZ displacement - case (VF_TransVel) - Values(p%Vars%x(i)%iLoc) = x%dqdt(1:3,p%Vars%x(i)%iUsr) ! XYZ velocity - case (VF_Orientation) - Values(p%Vars%x(i)%iLoc) = x%q(4:6,p%Vars%x(i)%iUsr) ! WM parameters - case (VF_AngularVel) - Values(p%Vars%x(i)%iLoc) = x%dqdt(4:6,p%Vars%x(i)%iUsr) ! Angular velocity - end select - end do -end subroutine - -subroutine BD_UnpackStateValues(p, Values, x) - type(BD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Values(:) - type(BD_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (VF_TransDisp) - x%q(1:3,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! XYZ displacement - case (VF_TransVel) - x%dqdt(1:3,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! XYZ velocity - case (VF_Orientation) - x%q(4:6,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! WM parameters - case (VF_AngularVel) - x%dqdt(4:6,p%Vars%x(i)%iUsr) = Values(p%Vars%x(i)%iLoc) ! Angular velocity - end select - end do -end subroutine - -subroutine BD_PackInputValues(p, u, Values) - type(BD_ParameterType), intent(in) :: p - type(BD_InputType), intent(in) :: u - real(R8Ki), intent(out) :: Values(:) - integer(IntKi) :: iv - iv = 1 - call MV_PackMesh(p%Vars%u, iv, u%RootMotion, Values) - call MV_PackMesh(p%Vars%u, iv, u%PointLoad, Values) - call MV_PackMesh(p%Vars%u, iv, u%DistrLoad, Values) -end subroutine - -subroutine BD_UnpackInputValues(p, Values, u) - type(BD_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: Values(:) - type(BD_InputType), intent(inout) :: u - integer(IntKi) :: iv - iv = 1 - call MV_UnpackMesh(p%Vars%u, iv, Values, u%RootMotion) - call MV_UnpackMesh(p%Vars%u, iv, Values, u%PointLoad) - call MV_UnpackMesh(p%Vars%u, iv, Values, u%DistrLoad) -end subroutine - -subroutine BD_PackOutputValues(p, y, Values) - type(BD_ParameterType), intent(in) :: p - type(BD_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: Values(:) - integer(IntKi) :: iv - iv = 1 - call MV_PackMesh(p%Vars%y, iv, y%ReactionForce, Values) - call MV_PackMesh(p%Vars%y, iv, y%BldMotion, Values) ! TODO: Add TrimOP - do while (iv <= size(p%Vars%y)) - call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr), Values) - end do -end subroutine - !----------------------------------------------------------------------------------------------------------------------------------- END MODULE BeamDyn diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index fbe315a112..8af355edf0 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -529,7 +529,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ! Add variable (only active variables are in x) call MV_AddVar(p%Vars%x, Var%Name, Var%Field, Flags=Var%Flags, & - iUsr=Var%iUsr, Perturb=Var%Perturb, LinNames=Var%LinNames) + iUsr=Var%iUsr(1), Perturb=Var%Perturb, LinNames=Var%LinNames) end do !---------------------------------------------------------------------------- @@ -712,6 +712,107 @@ logical function Failed() Failed = ErrStat >= AbortErrLev end function Failed end subroutine + + +subroutine ED_PackStateValues(p, x, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr(1)) + case (VF_TransVel, VF_AngularVel) + ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr(1)) + end select + end do +end subroutine + +subroutine ED_UnpackStateValues(p, ary, x) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(ED_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%Field) + case (VF_TransDisp, VF_AngularDisp) + x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) + case (VF_TransVel, VF_AngularVel) + x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) + end select + end do +end subroutine + +subroutine ED_PackInputValues(p, u, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_InputType), intent(in) :: u + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_PackMesh(p%Vars%u, iv, u%BladePtLoads(i), ary) + end do + end if + call MV_PackMesh(p%Vars%u, iv, u%PlatformPtMesh, ary) + call MV_PackMesh(p%Vars%u, iv, u%TowerPtLoads, ary) + call MV_PackMesh(p%Vars%u, iv, u%HubPtLoad, ary) + call MV_PackMesh(p%Vars%u, iv, u%NacelleLoads, ary) + call MV_PackVar(p%Vars%u, iv, u%BlPitchCom, ary) + call MV_PackVar(p%Vars%u, iv, u%YawMom, ary) + call MV_PackVar(p%Vars%u, iv, u%GenTrq, ary) + call MV_PackVar(p%Vars%u, iv, u%BlPitchCom(1), ary) +end subroutine + +subroutine ED_UnpackInputValues(p, ary, u) + type(ED_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(ED_InputType), intent(inout) :: u + integer(IntKi) :: iv, i + iv = 1 + if (allocated(u%BladePtLoads)) then + do i = 1, size(u%BladePtLoads) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%BladePtLoads(i)) + end do + end if + call MV_UnpackMesh(p%Vars%u, iv, ary, u%PlatformPtMesh) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%TowerPtLoads) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%HubPtLoad) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%NacelleLoads) + call MV_UnpackVar(p%Vars%u, iv, ary, u%BlPitchCom) + call MV_UnpackVar(p%Vars%u, iv, ary, u%YawMom) + call MV_UnpackVar(p%Vars%u, iv, ary, u%GenTrq) +end subroutine + +subroutine ED_PackOutputValues(p, y, ary) + type(ED_ParameterType), intent(in) :: p + type(ED_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + if (allocated(y%BladeLn2Mesh)) then + do i = 1, size(y%BladeLn2Mesh) + call MV_PackMesh(p%Vars%y, iv, y%BladeLn2Mesh(i), ary) + end do + end if + call MV_PackMesh(p%Vars%y, iv, y%PlatformPtMesh, ary) + call MV_PackMesh(p%Vars%y, iv, y%TowerLn2Mesh, ary) + call MV_PackMesh(p%Vars%y, iv, y%HubPtMotion, ary) + if (allocated(y%BladeRootMotion)) then + do i = 1, size(y%BladeRootMotion) + call MV_PackMesh(p%Vars%y, iv, y%BladeRootMotion(i), ary) + end do + end if + call MV_PackMesh(p%Vars%y, iv, y%NacelleMotion, ary) + call MV_PackVar(p%Vars%y, iv, y%Yaw, ary) + call MV_PackVar(p%Vars%y, iv, y%YawRate, ary) + call MV_PackVar(p%Vars%y, iv, y%HSS_Spd, ary) + do while (iv <= size(p%Vars%y)) + call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr(1):p%Vars%y(iv)%iUsr(2)), ary) + end do +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE ED_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) @@ -10547,7 +10648,7 @@ END SUBROUTINE FixHSSBrTq !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu, IsSolve ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10572,12 +10673,14 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] + LOGICAL, OPTIONAL, intent(in) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables ! local variables TYPE(ED_OutputType) :: y_p TYPE(ED_ContinuousStateType) :: x_p TYPE(ED_InputType) :: u_perturb INTEGER(IntKi) :: i, j, k + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10589,6 +10692,12 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = '' m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function + + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if ! make a copy of the inputs to perturb call ED_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return @@ -10604,17 +10713,14 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Copy outputs because we will need two for the central difference computations (with orientations) + call ED_CopyOutput(y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Loop through input variables do i = 1, size(p%Vars%u) - ! If extended linearization variable, skip - if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle - - ! TODO: Remove for linearization - if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -10653,11 +10759,8 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Loop through input variables do i = 1,size(p%Vars%u) - ! If extended linearization variable, skip - if (iand(p%Vars%u(i)%Flags, VF_Ext) > 0) cycle - - ! TODO: Remove for linearization - if (iand(p%Vars%u(i)%Flags, VF_Solve) == 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%u(i)%Num @@ -10712,7 +10815,7 @@ END SUBROUTINE ED_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx, IsSolve ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -10737,12 +10840,14 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) with respect !! to the continuous states (x) [intent in to avoid deallocation] + LOGICAL, OPTIONAL, INTENT(IN) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables ! local variables TYPE(ED_OutputType) :: y_p TYPE(ED_ContinuousStateType) :: x_p TYPE(ED_ContinuousStateType) :: x_perturb INTEGER(IntKi) :: i, j, k + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10755,6 +10860,12 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg = '' m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if + ! Pack operating point state values for perturbations call ED_PackStateValues(p, x, m%Vals%x) @@ -10775,11 +10886,8 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through state variables do i = 1,size(p%Vars%x) - ! If extended linearization variable, skip - if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle - - ! TODO: Remove for linearization - if (iand(p%Vars%x(i)%Flags, VF_Solve) == 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%x(i)%Num @@ -10815,11 +10923,8 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Loop through state variables do i = 1,size(p%Vars%x) - ! If extended linearization variable, skip - if (iand(p%Vars%x(i)%Flags, VF_Ext) > 0) cycle - - ! TODO: Remove for linearization - if (iand(p%Vars%x(i)%Flags, VF_Solve) == 0) cycle + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle ! Loop through number of linearization perturbations in variable do j = 1,p%Vars%x(i)%Num @@ -11132,106 +11237,5 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, END SUBROUTINE ED_GetOP !---------------------------------------------------------------------------------------------------------------------------------- -subroutine ED_PackStateValues(p, x, ary) - type(ED_ParameterType), intent(in) :: p - type(ED_ContinuousStateType), intent(in) :: x - real(R8Ki), intent(out) :: ary(:) - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (VF_TransDisp, VF_AngularDisp) - ary(p%Vars%x(i)%iLoc(1)) = x%QT(p%Vars%x(i)%iUsr) - case (VF_TransVel, VF_AngularVel) - ary(p%Vars%x(i)%iLoc(1)) = x%QDT(p%Vars%x(i)%iUsr) - end select - end do -end subroutine - -subroutine ED_UnpackStateValues(p, ary, x) - type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: ary(:) - type(ED_ContinuousStateType), intent(inout) :: x - integer(IntKi) :: i - do i = 1, size(p%Vars%x) - select case(p%Vars%x(i)%Field) - case (VF_TransDisp, VF_AngularDisp) - x%QT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) - case (VF_TransVel, VF_AngularVel) - x%QDT(p%Vars%x(i)%iUsr) = ary(p%Vars%x(i)%iLoc(1)) - end select - end do -end subroutine - -subroutine ED_PackInputValues(p, u, ary) - type(ED_ParameterType), intent(in) :: p - type(ED_InputType), intent(in) :: u - real(R8Ki), intent(out) :: ary(:) - integer(IntKi) :: iv, i - iv = 1 - if (allocated(u%BladePtLoads)) then - do i = 1, size(u%BladePtLoads) - call MV_PackMesh(p%Vars%u, iv, u%BladePtLoads(i), ary) - end do - end if - call MV_PackMesh(p%Vars%u, iv, u%PlatformPtMesh, ary) - call MV_PackMesh(p%Vars%u, iv, u%TowerPtLoads, ary) - call MV_PackMesh(p%Vars%u, iv, u%HubPtLoad, ary) - call MV_PackMesh(p%Vars%u, iv, u%NacelleLoads, ary) - call MV_PackVar(p%Vars%u, iv, u%BlPitchCom, ary) - call MV_PackVar(p%Vars%u, iv, u%YawMom, ary) - call MV_PackVar(p%Vars%u, iv, u%GenTrq, ary) - call MV_PackVar(p%Vars%u, iv, u%BlPitchCom(1), ary) -end subroutine - -subroutine ED_UnpackInputValues(p, ary, u) - type(ED_ParameterType), intent(in) :: p - real(R8Ki), intent(in) :: ary(:) - type(ED_InputType), intent(inout) :: u - integer(IntKi) :: iv, i - iv = 1 - if (allocated(u%BladePtLoads)) then - do i = 1, size(u%BladePtLoads) - call MV_UnpackMesh(p%Vars%u, iv, ary, u%BladePtLoads(i)) - end do - end if - call MV_UnpackMesh(p%Vars%u, iv, ary, u%PlatformPtMesh) - call MV_UnpackMesh(p%Vars%u, iv, ary, u%TowerPtLoads) - call MV_UnpackMesh(p%Vars%u, iv, ary, u%HubPtLoad) - call MV_UnpackMesh(p%Vars%u, iv, ary, u%NacelleLoads) - call MV_UnpackVar(p%Vars%u, iv, ary, u%BlPitchCom) - call MV_UnpackVar(p%Vars%u, iv, ary, u%YawMom) - call MV_UnpackVar(p%Vars%u, iv, ary, u%GenTrq) -end subroutine - -subroutine ED_PackOutputValues(p, y, ary) - type(ED_ParameterType), intent(in) :: p - type(ED_OutputType), intent(in) :: y - real(R8Ki), intent(out) :: ary(:) - integer(IntKi) :: iv, i, j - iv = 1 - if (allocated(y%BladeLn2Mesh)) then - do i = 1, size(y%BladeLn2Mesh) - call MV_PackMesh(p%Vars%y, iv, y%BladeLn2Mesh(i), ary) - end do - end if - call MV_PackMesh(p%Vars%y, iv, y%PlatformPtMesh, ary) - call MV_PackMesh(p%Vars%y, iv, y%TowerLn2Mesh, ary) - call MV_PackMesh(p%Vars%y, iv, y%HubPtMotion, ary) - if (allocated(y%BladeRootMotion)) then - do i = 1, size(y%BladeRootMotion) - call MV_PackMesh(p%Vars%y, iv, y%BladeRootMotion(i), ary) - end do - end if - call MV_PackMesh(p%Vars%y, iv, y%NacelleMotion, ary) - call MV_PackVar(p%Vars%y, iv, y%Yaw, ary) - call MV_PackVar(p%Vars%y, iv, y%YawRate, ary) - call MV_PackVar(p%Vars%y, iv, y%HSS_Spd, ary) - do while (iv <= size(p%Vars%y)) - i = p%Vars%y(iv)%iUsr - j = i + p%Vars%y(iv)%Num - 1 - call MV_PackVar(p%Vars%y, iv, y%WriteOutput(i:j), ary) - end do -end subroutine - END MODULE ElastoDyn !********************************************************************************************************************************** diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 3a6528326c..3dac37cc90 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -617,7 +617,7 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, Perturb, LinNa ! Set optional values if (present(Num)) Var%Num = Num if (present(Flags)) Var%Flags = Flags - if (present(iUsr)) Var%iUsr = iUsr + if (present(iUsr)) Var%iUsr = [iUsr, iUsr + Var%Num - 1] if (present(jUsr)) Var%jUsr = jUsr if (present(Perturb)) Var%Perturb = Perturb if (present(LinNames)) then diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index be5cd56627..c20e288196 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -49,9 +49,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_NoLin = 8 ! Variable to be linearized [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 16 ! Variable for extended linearization [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Solve = 32 ! Variable used for input residual calculation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] @@ -120,9 +118,10 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] - INTEGER(IntKi) :: iUsr = 0 !< first user defined index for variable [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= @@ -816,6 +815,7 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + DstModVarTypeData%Solve = SrcModVarTypeData%Solve if (allocated(SrcModVarTypeData%LinNames)) then LB(1:1) = lbound(SrcModVarTypeData%LinNames) UB(1:1) = ubound(SrcModVarTypeData%LinNames) @@ -888,6 +888,7 @@ subroutine NWTC_Library_PackModVarType(Buf, Indata) call RegPack(Buf, InData%iUsr) call RegPack(Buf, InData%jUsr) call RegPack(Buf, InData%Perturb) + call RegPack(Buf, InData%Solve) call RegPack(Buf, allocated(InData%LinNames)) if (allocated(InData%LinNames)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames), ubound(InData%LinNames)) @@ -978,6 +979,8 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Perturb) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Solve) + if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%LinNames)) deallocate(OutData%LinNames) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 68f7d70bb6..468145b22b 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -55,9 +55,7 @@ param ^ - IntKi VF_None - 0 - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_NoLin - 8 - "Variable to be linearized" - -param ^ - IntKi VF_Ext - 16 - "Variable for extended linearization" - -param ^ - IntKi VF_Solve - 32 - "Variable used for input residual calculation" - +param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - param ^ - IntKi VC_None - 0 - "" - @@ -75,9 +73,10 @@ typedef ^ ^ IntKi iLoc : - - typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - -typedef ^ ^ IntKi iUsr - 0 - "first user defined index for variable" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi ModNum - 0 - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index d562b48f6a..9eb4eabf08 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -55,9 +55,7 @@ param ^ - IntKi VF_None - 0 - param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - -param ^ - IntKi VF_NoLin - 8 - "Variable to be linearized" - -param ^ - IntKi VF_Ext - 16 - "Variable for extended linearization" - -param ^ - IntKi VF_Solve - 32 - "Variable used for input residual calculation" - +param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - param ^ - IntKi VC_None - 0 - "" - @@ -75,9 +73,10 @@ typedef ^ ^ IntKi iLoc : - - typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - -typedef ^ ^ IntKi iUsr - 0 - "first user defined index for variable" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi ModNum - 0 - "" - diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 26f9d5ab51..81085017e5 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -325,11 +325,11 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS do j = 1, size(p_BD%Vars%x) select case (p_BD%Vars%x(j)%Field) case (VF_TransDisp) - os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 3) - os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 4) + os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) + os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) case (VF_Orientation) - os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 3) - os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) = q_TC(p_BD%Vars%x(j)%iq, 4) + os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 3) + os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) = q_TC(p_BD%Vars%x(j)%iq, 4) end select end do @@ -341,11 +341,11 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS do j = 1, size(p_BD%Vars%x) select case (p_BD%Vars%x(j)%Field) case (VF_TransDisp) - q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr) - q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr) + q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(1:3, p_BD%Vars%x(j)%iUsr(1)) + q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(1:3, p_BD%Vars%x(j)%iUsr(1)) case (VF_Orientation) - q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr) - q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr) + q_TC(p_BD%Vars%x(j)%iq, 3) = os_BD%acc(4:6, p_BD%Vars%x(j)%iUsr(1)) + q_TC(p_BD%Vars%x(j)%iq, 4) = os_BD%xcc(4:6, p_BD%Vars%x(j)%iUsr(1)) end select end do @@ -485,34 +485,34 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) call MapMotionMesh(Key='ED TowerMotion -> AD TowerMotion', & SrcMod=ModSrc, SrcMeshName='TowerMotion', & - DstMod=ModDst, DstMeshName='TowerMotion', & + DstMod=ModDst, DstMeshName='R1TowerMotion', & Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) call MapMotionMesh(Key='ED HubMotion -> AD HubMotion', & SrcMod=ModSrc, SrcMeshName='HubMotion', & - DstMod=ModDst, DstMeshName='HubMotion') + DstMod=ModDst, DstMeshName='R1HubMotion') call MapMotionMesh(Key='ED NacelleMotion -> AD NacelleMotion', & SrcMod=ModSrc, SrcMeshName='NacelleMotion', & - DstMod=ModDst, DstMeshName='NacelleMotion', & + DstMod=ModDst, DstMeshName='R1NacelleMotion', & Active=T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) call MapMotionMesh(Key='ED TFinMotion -> AD TFinMotion', & SrcMod=ModSrc, SrcMeshName='TFinMotion', & - DstMod=ModDst, DstMeshName='TFinMotion', & + DstMod=ModDst, DstMeshName='R1TFinMotion', & Active=T%AD%Input(1)%rotors(1)%TFinMotion%Committed) do i = 1, size(T%ED%y%BladeRootMotion) call MapMotionMesh(Key='ED BladeRootMotion -> AD BladeRootMotion', i1=i, & SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//IdxStr(i), & - DstMod=ModDst, DstMeshName='BladeRootMotion'//IdxStr(i)) + DstMod=ModDst, DstMeshName='R1BladeRootMotion'//IdxStr(i)) end do if (T%p_FAST%CompElast == Module_ED) then do i = 1, size(T%ED%y%BladeLn2Mesh) call MapMotionMesh(Key='ED BladeMotion -> AD BladeMotion', i1=i, & SrcMod=ModSrc, SrcMeshName='BladeMotion'//IdxStr(i), & - DstMod=ModDst, DstMeshName='BladeMotion'//IdxStr(i)) + DstMod=ModDst, DstMeshName='R1BladeMotion'//IdxStr(i)) end do end if @@ -520,7 +520,7 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) call MapMotionMesh(Key='BD BladeMotion -> AD BladeMotion', & SrcMod=ModSrc, SrcMeshName='BladeMotion', & - DstMod=ModDst, DstMeshName='BladeMotion'//IdxStr(ModSrc%Ins)) + DstMod=ModDst, DstMeshName='R1BladeMotion'//IdxStr(ModSrc%Ins)) case (Module_SrvD) @@ -673,41 +673,20 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Destination displacement mesh is in output of destination module (only translation displacement needed) Map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, Map%DstDispMeshName, VF_TransDisp) - ! If source mesh not found, return with error - if (size(Map%SrcVarIdx) == 0) then - call SetErrStat(ErrID_Fatal, 'No load fields found for src mesh '//trim(Map%SrcMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) - return - end if - - ! If source displacement mesh not found, return with error - if (Map%SrcDispVarIdx == 0) then - call SetErrStat(ErrID_Fatal, 'No TransDisp field found for src mesh '//trim(Map%SrcDispMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) - return - end if - - ! If destination mesh not found, return with error - if (size(Map%SrcVarIdx) == 0) then - call SetErrStat(ErrID_Fatal, 'No load fields found for dst mesh '//trim(Map%DstMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) - return - end if + ! If source or destination meshes not found, return error + if (size(Map%SrcVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No load fields found for src mesh '//Map%SrcMeshName, ErrStat, ErrMsg, RoutineName) + if (size(Map%DstVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No load fields found for dst mesh '//Map%DstMeshName, ErrStat, ErrMsg, RoutineName) + if (Map%SrcDispVarIdx == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No TransDisp field found for src mesh '//Map%SrcDispMeshName, ErrStat, ErrMsg, RoutineName) + if (Map%DstDispVarIdx == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No TransDisp field found for dst mesh '//Map%DstDispMeshName, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - ! If source displacement mesh not found, return with error - if (Map%DstDispVarIdx == 0) then - call SetErrStat(ErrID_Fatal, 'No TransDisp field found for dst mesh '//trim(Map%DstDispMeshName)//' in mapping '//trim(Map%Key), ErrStat, ErrMsg, RoutineName) - return - end if - - ! Mark variables with Solve flag - do i = 1, size(map%SrcVarIdx) - call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(i)), VF_Solve) - end do - do i = 1, size(map%DstVarIdx) - call SetFlags(DstMod%Vars%u(map%DstVarIdx(i)), VF_Solve) - end do + ! Set Variable solve flag to true + SrcMod%Vars%y(map%SrcVarIdx)%Solve = .true. + DstMod%Vars%u(map%DstVarIdx)%Solve = .true. - ! Mark displacement variables with Solve flag - if (Map%SrcDispVarIdx > 0) call SetFlags(SrcMod%Vars%u(Map%SrcDispVarIdx), VF_Solve) - if (Map%DstDispVarIdx > 0) call SetFlags(DstMod%Vars%y(Map%DstDispVarIdx), VF_Solve) + ! Set displacement variable solve flag to true + if (Map%SrcDispVarIdx > 0) SrcMod%Vars%u(Map%SrcDispVarIdx)%Solve = .true. + if (Map%DstDispVarIdx > 0) DstMod%Vars%y(Map%DstDispVarIdx)%Solve = .true. case (Map_MotionMesh) @@ -719,27 +698,14 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(i)), i=1, size(MotionFields))] map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) - ! If source mesh not found, return with error - if (size(Map%SrcVarIdx) == 0) then - call SetErrStat(ErrID_Fatal, 'No load fields found for src mesh '//trim(Map%SrcMeshName)//' in mapping '//trim(Map%Key), & - ErrStat, ErrMsg, RoutineName) - return - end if - - ! If destination mesh not found, return with error - if (size(Map%SrcVarIdx) == 0) then - call SetErrStat(ErrID_Fatal, 'No load fields found for dst mesh '//trim(Map%DstMeshName)//' in mapping '//trim(Map%Key), & - ErrStat, ErrMsg, RoutineName) - return - end if + ! If source or destination meshes not found, return error + if (size(Map%SrcVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No motion fields found for src mesh '//Map%SrcMeshName, ErrStat, ErrMsg, RoutineName) + if (size(Map%DstVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No motion fields found for dst mesh '//Map%DstMeshName, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - ! Mark variables with Solve flag - do i = 1, size(map%SrcVarIdx) - call SetFlags(SrcMod%Vars%y(map%SrcVarIdx(i)), VF_Solve) - end do - do i = 1, size(map%DstVarIdx) - call SetFlags(DstMod%Vars%u(map%DstVarIdx(i)), VF_Solve) - end do + ! Set Variable solve flag to true + SrcMod%Vars%y(map%SrcVarIdx)%Solve = .true. + DstMod%Vars%u(map%DstVarIdx)%Solve = .true. case (Map_NonMesh) ! Nothing to do for non-mesh mapping @@ -1523,11 +1489,10 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcContStateDeriv(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, ErrMsg, dxdt) +subroutine FAST_CalcContStateDeriv(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, dxdt) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: ThisState !< State index - logical, intent(in) :: IsSolve !< Calculate solver derivs, otherwise linearization type(FAST_TurbineType), intent(inout) :: T !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1590,7 +1555,102 @@ logical function Failed() end function end subroutine -subroutine FAST_CalcJacobian(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, ErrMsg, dYdx, dXdx, dYdu, dXdu) +subroutine FAST_JacobianPInput(MD, ThisTime, ThisState, IsSolve, T, ErrStat, ErrMsg, dYdu, dXdu) + type(ModDataType), intent(in) :: MD !< Module data + real(DbKi), intent(in) :: ThisTime !< Time + integer(IntKi), intent(in) :: ThisState !< State + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + logical, intent(in) :: IsSolve !< Calculate solver Jacobians, otherwise linearization + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:, :), dXdu(:, :) + + character(*), parameter :: RoutineName = 'FAST_JacobianPInput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: Args + + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate number representing which arguments are present + Args = 0 + if (present(dYdu)) Args = Args + 1 + if (present(dXdu)) Args = Args + 2 + + ! Select based on module ID + select case (MD%ID) + +! case (Module_AD) + + case (Module_BD) + + select case (Args) + case (1) + call BD_JacobianPInput(ThisTime, T%BD%Input(1, MD%Ins), T%BD%p(MD%Ins), T%BD%x(MD%Ins, ThisState), T%BD%xd(MD%Ins, ThisState), & + T%BD%z(MD%Ins, ThisState), T%BD%OtherSt(MD%Ins, ThisState), T%BD%y(MD%Ins), T%BD%m(MD%Ins), & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%BD%m(MD%Ins)%Vals%dYdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%BD%m(MD%Ins)%Vals%dYdu, dYdu) + case (2) + call BD_JacobianPInput(ThisTime, T%BD%Input(1, MD%Ins), T%BD%p(MD%Ins), T%BD%x(MD%Ins, ThisState), T%BD%xd(MD%Ins, ThisState), & + T%BD%z(MD%Ins, ThisState), T%BD%OtherSt(MD%Ins, ThisState), T%BD%y(MD%Ins), T%BD%m(MD%Ins), & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dXdu=T%BD%m(MD%Ins)%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%ixs, MD%ius, T%BD%m(MD%Ins)%Vals%dXdu, dXdu) + case (3) + call BD_JacobianPInput(ThisTime, T%BD%Input(1, MD%Ins), T%BD%p(MD%Ins), T%BD%x(MD%Ins, ThisState), T%BD%xd(MD%Ins, ThisState), & + T%BD%z(MD%Ins, ThisState), T%BD%OtherSt(MD%Ins, ThisState), T%BD%y(MD%Ins), T%BD%m(MD%Ins), & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%BD%m(MD%Ins)%Vals%dYdu, dXdu=T%BD%m(MD%Ins)%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%BD%m(MD%Ins)%Vals%dYdu, dYdu) + call XferLocToGbl2D(MD%ixs, MD%ius, T%BD%m(MD%Ins)%Vals%dXdu, dXdu) + end select + + case (Module_ED) + + select case (Args) + case (1) + call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%ED%m%Vals%dYdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%ED%m%Vals%dYdu, dYdu) + case (2) + call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%ixs, MD%ius, T%ED%m%Vals%dXdu, dXdu) + case (3) + call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%ED%m%Vals%dYdu, dYdu) + call XferLocToGbl2D(MD%ixs, MD%ius, T%ED%m%Vals%dXdu, dXdu) + end select + +! case (Module_ExtPtfm) +! case (Module_FEAM) +! case (Module_HD) +! case (Module_IceD) +! case (Module_IceF) +! case (Module_IfW) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) +! case (Module_SD) +! case (Module_SeaSt) +! case (Module_SrvD) + case default + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(MD%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, ErrMsg, dYdx, dXdx) type(ModDataType), intent(in) :: ModData !< Module data real(DbKi), intent(in) :: ThisTime !< Time integer(IntKi), intent(in) :: ThisState !< State @@ -1598,16 +1658,21 @@ subroutine FAST_CalcJacobian(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, logical, intent(in) :: IsSolve !< Calculate solver Jacobians, otherwise linearization integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg - real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :), dYdu(:, :), dXdu(:, :) + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:, :), dXdx(:, :) - character(*), parameter :: RoutineName = 'FAST_CalcJacobian' + character(*), parameter :: RoutineName = 'FAST_JacobianPContState' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j_ss ! substep loop counter + integer(IntKi) :: Args ErrStat = ErrID_None ErrMsg = '' + ! Calculate number representing which arguments are present + Args = 0 + if (present(dYdx)) Args = Args + 1 + if (present(dXdx)) Args = Args + 2 + ! Select based on module ID select case (ModData%ID) @@ -1615,31 +1680,57 @@ subroutine FAST_CalcJacobian(ModData, ThisTime, ThisState, IsSolve, T, ErrStat, case (Module_BD) - call BD_JacobianPInput(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & - T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & - ErrStat2, ErrMsg2, dYdu=T%BD%m(ModData%Ins)%Vals%dYdu, dXdu=T%BD%m(ModData%Ins)%Vals%dXdu); if (Failed()) return - if (present(dYdu)) call XferLocToGbl2D(ModData%iys, ModData%ius, T%BD%m(ModData%Ins)%Vals%dYdu, dYdu) - if (present(dXdu)) call XferLocToGbl2D(ModData%ixs, ModData%ius, T%BD%m(ModData%Ins)%Vals%dXdu, dXdu) - - call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & - T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), & - ErrStat2, ErrMsg2, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return - if (present(dYdx)) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) - if (present(dXdx)) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) + select case (Args) + case (1) + call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx); if (Failed()) return + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) + case (2) + call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) + case (3) + call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & + T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & + T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) + end select case (Module_ED) - call ED_JacobianPInput(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & - T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & - ErrStat2, ErrMsg2, dYdu=T%ED%m%Vals%dYdu, dXdu=T%ED%m%Vals%dXdu); if (Failed()) return - if (present(dYdu)) call XferLocToGbl2D(ModData%iys, ModData%ius, T%ED%m%Vals%dYdu, dYdu) - if (present(dXdu)) call XferLocToGbl2D(ModData%ixs, ModData%ius, T%ED%m%Vals%dXdu, dXdu) - - call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, T%ED%x(ThisState), T%ED%xd(ThisState), & - T%ED%z(ThisState), T%ED%OtherSt(ThisState), T%ED%y, T%ED%m, & - ErrStat2, ErrMsg2, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return - if (present(dYdx)) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) - if (present(dXdx)) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) + select case (Args) + case (1) + call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & + T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), & + T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%ED%m%Vals%dYdx); if (Failed()) return + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) + case (2) + call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & + T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), & + T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) + case (3) + call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & + T%ED%x(ThisState), T%ED%xd(ThisState), & + T%ED%z(ThisState), T%ED%OtherSt(ThisState), & + T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) + end select ! case (Module_ExtPtfm) ! case (Module_FEAM) diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index e13be88cea..06a21cbede 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -4294,9 +4294,20 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'FAST_Solution0_T' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + if (Turbine%p_FAST%WrSttsTime) then + call SimStatus_FirstTime(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%SimStrtTime, Turbine%m_FAST%UsrTime2, Turbine%m_FAST%t_global, & + Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + ! Get initial conditions for solver - CALL Solver_Step0(Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat, ErrMsg) - if (ErrStat >= AbortErrLev) return + CALL Solver_Step0(Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return ! CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & ! Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& @@ -4306,7 +4317,8 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) CALL WriteOutputToFile(0, Turbine%m_FAST%t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SeaSt, Turbine%HD, Turbine%SD, & Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -4893,7 +4905,7 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = '' - ! Get initial conditions for solver + ! Advance simulation one step and calculate outputs CALL Solver_Step(n_t_global, t_initial, Turbine%p_FAST%Solver, Turbine%m_FAST%Solver, Turbine%m_FAST%Modules, Turbine, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -4903,12 +4915,27 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) ! Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + !---------------------------------------------------------------------------- + ! Write output data to file + !---------------------------------------------------------------------------- + CALL WriteOutputToFile(n_t_global + 1, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%BD, & Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SeaSt, Turbine%HD, Turbine%SD, & Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !---------------------------------------------------------------------------- + ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------- + + if (Turbine%p_FAST%WrSttsTime) then + if (MOD(n_t_global + 1, Turbine%p_FAST%n_SttsTime) == 0) then + call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & + Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) + end if + end if + END SUBROUTINE FAST_Solution_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine takes data from n_t_global and gets values at n_t_global + 1 diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 5cbe05eb66..5bc3b22acf 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -241,25 +241,15 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! Initialize number of state variables to zero NumX = 0 - ! Loop through tight coupling modules, set Solve flag + ! Loop through tight coupling modules, set Solve flag for all states do i = 1, size(p%iModTC) - associate (Mod => Mods(p%iModTC(i))) - do j = 1, size(Mod%Vars%x) - call SetFlags(Mod%Vars%x(j), VF_Solve) - end do - end associate + Mods(p%iModTC(i))%Vars%x%Solve = .true. end do ! Loop through x displacement variables (DerivOrder == 0), set global index do i = 1, size(p%iModTC) - associate (Mod => Mods(p%iModTC(i))) - do j = 1, size(Mod%Vars%x) - if (Mod%Vars%x(j)%DerivOrder == 0) then - Mod%Vars%x(j)%iSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] - NumX = NumX + Mod%Vars%x(j)%Num - end if - end do - end associate + call SetGlobalIndices(Mods(p%iModTC(i))%Vars%x, NumX, & + Mods(p%iModTC(i))%Vars%x%DerivOrder == 0) end do ! Start and end indices for first derivative of X @@ -267,14 +257,8 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! Loop through x velocity variables (DerivOrder == 1), set global index do i = 1, size(p%iModTC) - associate (Mod => Mods(p%iModTC(i))) - do j = 1, size(Mod%Vars%x) - if (Mod%Vars%x(j)%DerivOrder == 1) then - Mod%Vars%x(j)%iSol = [(NumX + k, k=1, Mod%Vars%x(j)%Num)] - NumX = NumX + Mod%Vars%x(j)%Num - end if - end do - end associate + call SetGlobalIndices(Mods(p%iModTC(i))%Vars%x, NumX, & + Mods(p%iModTC(i))%Vars%x%DerivOrder == 1) end do ! Start and end indices for second derivative of X @@ -307,14 +291,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! Loop through tight coupling modules and calculate global indices do i = 1, size(p%iModTC) - do j = 1, size(Mods(p%iModTC(i))%Vars%u) - associate (Var => Mods(p%iModTC(i))%Vars%u(j)) - if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iSol = [(NumU + k, k=1, Var%Num)] - NumU = NumU + Var%Num - end if - end associate - end do + call SetGlobalIndices(Mods(p%iModTC(i))%Vars%u, NumU) end do ! Save number of tight coupling inputs @@ -322,14 +299,7 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! Loop through option 1 modules and calculate global indices do i = 1, size(p%iModOpt1) - do j = 1, size(Mods(p%iModOpt1(i))%Vars%u) - associate (Var => Mods(p%iModOpt1(i))%Vars%u(j)) - if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iSol = [(NumU + k, k=1, Var%Num)] - NumU = NumU + Var%Num - end if - end associate - end do + call SetGlobalIndices(Mods(p%iModOpt1(i))%Vars%u, NumU) end do ! Save number of option 1 inputs @@ -360,31 +330,17 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, ! Initialize the number of output variables NumY = 0 - ! Loop through tight coupling modules and calculate global indices + ! Loop through tight coupling modules and calculate output global indices do i = 1, size(p%iModTC) - do j = 1, size(Mods(p%iModTC(i))%Vars%y) - associate (Var => Mods(p%iModTC(i))%Vars%y(j)) - if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iSol = [(NumY + k, k=1, Var%Num)] - NumY = NumY + Var%Num - end if - end associate - end do + call SetGlobalIndices(Mods(p%iModTC(i))%Vars%y, NumY) end do ! Save number of tight coupling inputs p%iyT = [1, NumY] - ! Loop through option 1 modules and calculate global indices + ! Loop through option 1 modules and calculate output global indices do i = 1, size(p%iModOpt1) - do j = 1, size(Mods(p%iModOpt1(i))%Vars%y) - associate (Var => Mods(p%iModOpt1(i))%Vars%y(j)) - if ((.not. allocated(Var%iSol)) .and. (iand(Var%Flags, VF_Solve) > 0)) then - Var%iSol = [(NumY + k, k=1, Var%Num)] - NumY = NumY + Var%Num - end if - end associate - end do + call SetGlobalIndices(Mods(p%iModOpt1(i))%Vars%y, NumY) end do ! Calculate number of option 1 inputs @@ -495,6 +451,21 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, p%iJL = iuLoad + NumQ contains + subroutine SetGlobalIndices(Vars, NumV, Mask) + type(ModVarType), intent(inout) :: Vars(:) + integer(IntKi), intent(inout) :: NumV + logical, optional, intent(in) :: Mask(:) + do j = 1, size(Vars) + if (present(Mask)) then + if (.not. Mask(j)) cycle + end if + if (Vars(j)%Solve .and. (.not. allocated(Vars(j)%iSol))) then + Vars(j)%iSol = [(NumV + k, k=1, Vars(j)%Num)] + NumV = NumV + Vars(j)%Num + end if + end do + end subroutine + logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev @@ -568,12 +539,6 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) t_global_next = t_initial + n_t_global_next*p%DT Turbine%y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, t_initial, Turbine%p_FAST%n_DT_Out) - if (Turbine%p_FAST%WrSttsTime) then - call SimStatus_FirstTime(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & - Turbine%m_FAST%SimStrtTime, Turbine%m_FAST%UsrTime2, t_initial, & - Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) - end if - ! Set flag to warn about convergence errors m%ConvWarn = .true. @@ -599,7 +564,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) ! TODO: may need a separate variable for max initial acceleration convergence iterations converged = .false. k = 1 - do while ((.not. converged) .and. (k <= p%MaxConvIter)) + do while ((.not. converged) .and. (k <= 2*p%MaxConvIter)) ! Transfer inputs and calculate outputs for all modules (use current state) do i = 1, size(p%iModInit) @@ -611,7 +576,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Calculate continuous state derivatives for tight coupling modules (use current state) do i = 1, size(p%iModTC) - call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_CURR, IsSolve, & + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_initial, STATE_CURR, & Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt); if (Failed()) return end do @@ -674,7 +639,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 logical, parameter :: IsSolve = .true. - integer(IntKi) :: iterConv, iterCorr + integer(IntKi) :: iterConv, iterCorr, NumCorrections real(ReKi) :: delta_norm real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 @@ -757,7 +722,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Loop through correction iterations iterCorr = 0 - do while (iterCorr <= p%NumCrctn) + NumCorrections = p%NumCrctn + do while (iterCorr <= NumCorrections) ! Copy state for correction step m%qn = m%q @@ -823,7 +789,17 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- if (iterConv >= p%MaxConvIter) then - if (m%ConvWarn) then + + ! If number of corrections is less than or the same as limit, + ! increase number of corrections and set counter to trigger + ! a Jacobian update on correction step. + if (NumCorrections <= p%NumCrctn) then + NumCorrections = NumCorrections + 1 + m%IterUntilUJac = 0 + + else if (m%ConvWarn) then + + ! Otherwise, warn that convergence failed call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & " iterations on step "//trim(Num2LStr(n_t_global_next))// & " (error="//trim(Num2LStr(delta_norm))// & @@ -831,6 +807,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM "). Warning will not be displayed again.", ErrStat, ErrMsg, RoutineName) m%ConvWarn = .false. end if + + ! Exit loop exit end if @@ -842,8 +820,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! is zero or less, or first solution step, then rebuild the Jacobian. ! Note: BuildJacobian resets these counters. if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0) .or. (n_t_global_next == 1)) then - call BuildJacobian(p, m, Mods, t_global_next, n_t_global_next*100 + iterConv, & - Turbine, ErrStat2, ErrMsg2) + call BuildJacobian(p, m, Mods, t_global_next, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end if @@ -853,7 +830,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Calculate continuous state derivatives for tight coupling modules do i = 1, size(p%iModTC) - call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_global_next, STATE_PRED, IsSolve, & + call FAST_CalcContStateDeriv(Mods(p%iModTC(i)), t_global_next, STATE_PRED, & Turbine, ErrStat2, ErrMsg2, dxdt=m%dxdt) if (Failed()) return end do @@ -889,9 +866,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Check perturbations for convergence and exit if below tolerance !---------------------------------------------------------------------- - ! Calculate average L2 norm of change in states and inputs + ! Calculate average L2 norm of change in states and inputs delta_norm = TwoNorm(m%XB(:, 1))/size(m%XB) + ! Write step debug info if requested if (DebugSolver) then call Solver_Step_Debug(p, m, n_t_global_next, iterCorr, iterConv, delta_norm) end if @@ -973,17 +951,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Update the global time Turbine%m_FAST%t_global = t_global_next - !---------------------------------------------------------------------------- - ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): - !---------------------------------------------------------------------------- - - if (Turbine%p_FAST%WrSttsTime) then - if (MOD(n_t_global_next, Turbine%p_FAST%n_SttsTime) == 0) then - call SimStatus(Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, & - Turbine%m_FAST%t_global, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc) - end if - end if - contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -991,12 +958,11 @@ logical function Failed() end function end subroutine -subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) +subroutine BuildJacobian(p, m, Mods, ThisTime, Turbine, ErrStat, ErrMsg) type(TC_ParameterType), intent(in) :: p !< Parameters type(TC_MiscVarType), intent(inout) :: m !< Misc variables type(ModDataType), intent(in) :: Mods(:) !< Array of module data - real(DbKi), intent(in) :: this_time !< Time - integer(IntKi), intent(in) :: iter + real(DbKi), intent(in) :: ThisTime !< Time type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type integer(IntKi), intent(out) :: ErrStat character(*), intent(out) :: ErrMsg @@ -1006,8 +972,6 @@ subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 logical, parameter :: IsSolve = .true. integer(IntKi) :: i, j - real(R8Ki), allocatable :: tmp(:, :) - real(R8Ki), dimension(3) :: wm_b, wm_p, wm_n, wm_d, wm_pert, delta ErrStat = ErrID_None ErrMsg = '' @@ -1028,23 +992,26 @@ subroutine BuildJacobian(p, m, Mods, this_time, iter, Turbine, ErrStat, ErrMsg) m%dXdu = 0.0_R8Ki m%dYdu = 0.0_R8Ki m%dUdy = 0.0_R8Ki - call Eye2D(m%dUdu, ErrStat2, ErrMsg2); if (Failed()) return + call Eye2D(m%dUdu, ErrStat2, ErrMsg2) + if (Failed()) return ! Calculate dYdx, dXdx, dXdu for tight coupling modules do i = 1, size(p%iModTC) - call FAST_CalcJacobian(Mods(p%iModTC(i)), this_time, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, & - dYdx=m%dYdx, dXdx=m%dXdx, dXdu=m%dXdu); if (Failed()) return + call FAST_JacobianPContState(Mods(p%iModTC(i)), ThisTime, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, dYdx=m%dYdx, dXdx=m%dXdx) + if (Failed()) return + call FAST_JacobianPInput(Mods(p%iModTC(i)), ThisTime, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, dXdu=m%dXdu) + if (Failed()) return end do ! Calculate dYdu Loop for Option 1 modules do i = 1, size(p%iModOpt1) - call FAST_CalcJacobian(Mods(p%iModOpt1(i)), this_time, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, & - dYdu=m%dYdu); if (Failed()) return + call FAST_JacobianPInput(Mods(p%iModOpt1(i)), ThisTime, STATE_PRED, IsSolve, Turbine, ErrStat2, ErrMsg2, dYdu=m%dYdu) + if (Failed()) return end do ! Calculate dUdu and dUdy for Option 1 meshes - call FAST_LinearizeMappings(Mods, p%iModOpt1, m%Mappings, Turbine, ErrStat2, ErrMsg2, & - dUdu=m%dUdu, dUdy=m%dUdy); if (Failed()) return + call FAST_LinearizeMappings(Mods, p%iModOpt1, m%Mappings, Turbine, ErrStat2, ErrMsg2, dUdu=m%dUdu, dUdy=m%dUdy) + if (Failed()) return !---------------------------------------------------------------------------- ! Form full system matrices @@ -1162,7 +1129,7 @@ subroutine AddDeltaToInputs(Mods, ModOrder, du, u) associate (Var => Mods(ModOrder(i))%Vars%u(j)) ! If this is not a solve variable, cycle - if (iand(Var%Flags, VF_Solve) == 0) cycle + if (.not. Var%Solve) cycle ! Select based on field type select case (Var%Field) From 5fff699475df84162db4414d361f08ac0ed148b1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 15 Sep 2023 18:02:46 +0000 Subject: [PATCH 52/61] Add ConvIter, ConvErr, and NumUJac to output file --- .../openfast-library/src/FAST_Registry.txt | 6 +- modules/openfast-library/src/FAST_Subs_TC.f90 | 35 +++--- modules/openfast-library/src/FAST_Types.f90 | 108 +++++++++++++++++- modules/openfast-library/src/Solver.f90 | 107 ++++++++++++----- 4 files changed, 207 insertions(+), 49 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 9e2cee19a4..2f5593bf70 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -456,9 +456,9 @@ typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" -typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {5} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed" -#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" -#typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnit {:} - - "units of data output from the driver" +typedef ^ FAST_OutputFileType ReKi WriteOutput {:} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed" +typedef ^ FAST_OutputFileType CHARACTER(ChanLen) WriteOutputHdr {:} - - "headers of data output from the driver" +typedef ^ FAST_OutputFileType CHARACTER(ChanLen) WriteOutputUnt {:} - - "units of data output from the driver" # ..... IceDyn data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index 06a21cbede..f145608ab9 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -1469,12 +1469,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF - ! ........................ - ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) - ! ........................ - CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! ------------------------------------------------------------------------- ! Initialize tight coupling solver @@ -1487,6 +1482,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ! ------------------------------------------------------------------------- + ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) + ! ------------------------------------------------------------------------- + + CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! ------------------------------------------------------------------------- ! Initialize mesh-mapping data ! ------------------------------------------------------------------------- @@ -2245,6 +2247,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) !...................................................... y_FAST%numOuts = 0 ! Inintialize entire array + IF ( ALLOCATED( y_FAST%WriteOutputHdr ) ) y_FAST%numOuts(Module_Glue) = SIZE(y_FAST%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(Init%OutData_OpFM%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) @@ -2272,22 +2275,24 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) !...................................................... ! Initialize the output channel names and units !...................................................... - y_FAST%numOuts(Module_Glue) = 1 ! time - - NumOuts = SUM( y_FAST%numOuts ) + NumOuts = SUM( y_FAST%numOuts ) + 1 CALL AllocAry( y_FAST%ChannelNames,NumOuts, 'ChannelNames', ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) RETURN CALL AllocAry( y_FAST%ChannelUnits,NumOuts, 'ChannelUnits', ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) RETURN - - ! Glue outputs: + y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' - - indxNext = y_FAST%numOuts(Module_Glue) + 1 + indxNext = 2 + + DO i=1,y_FAST%numOuts(Module_Glue) !GlueCode + y_FAST%ChannelNames(indxNext) = y_FAST%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = y_FAST%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) @@ -5541,9 +5546,9 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, indxLast = 0 indxNext = 1 - IF (y_FAST%numOuts(Module_Glue) > 1) THEN ! if we output more than just the time channel.... - indxLast = indxNext + SIZE(y_FAST%DriverWriteOutput) - 1 - OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput + IF (y_FAST%numOuts(Module_Glue) > 0) THEN ! if we output more than just the time channel.... + indxLast = indxNext + SIZE(y_FAST%WriteOutput) - 1 + OutputAry(indxNext:indxLast) = y_FAST%WriteOutput indxNext = IndxLast + 1 END IF diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 38954018cd..f275c59de4 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -461,7 +461,9 @@ MODULE FAST_Types TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] 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 = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< headers of data output from the driver [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< units of data output from the driver [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -8349,7 +8351,42 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, 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 + if (allocated(SrcOutputFileTypeData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputFileTypeData%WriteOutput) + UB(1:1) = ubound(SrcOutputFileTypeData%WriteOutput) + if (.not. allocated(DstOutputFileTypeData%WriteOutput)) then + allocate(DstOutputFileTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%WriteOutput = SrcOutputFileTypeData%WriteOutput + end if + if (allocated(SrcOutputFileTypeData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcOutputFileTypeData%WriteOutputHdr) + UB(1:1) = ubound(SrcOutputFileTypeData%WriteOutputHdr) + if (.not. allocated(DstOutputFileTypeData%WriteOutputHdr)) then + allocate(DstOutputFileTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%WriteOutputHdr = SrcOutputFileTypeData%WriteOutputHdr + end if + if (allocated(SrcOutputFileTypeData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcOutputFileTypeData%WriteOutputUnt) + UB(1:1) = ubound(SrcOutputFileTypeData%WriteOutputUnt) + if (.not. allocated(DstOutputFileTypeData%WriteOutputUnt)) then + allocate(DstOutputFileTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%WriteOutputUnt = SrcOutputFileTypeData%WriteOutputUnt + end if end subroutine subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) @@ -8385,6 +8422,15 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputFileTypeData%WriteOutput)) then + deallocate(OutputFileTypeData%WriteOutput) + end if + if (allocated(OutputFileTypeData%WriteOutputHdr)) then + deallocate(OutputFileTypeData%WriteOutputHdr) + end if + if (allocated(OutputFileTypeData%WriteOutputUnt)) then + deallocate(OutputFileTypeData%WriteOutputUnt) + end if end subroutine subroutine FAST_PackOutputFileType(Buf, Indata) @@ -8433,7 +8479,21 @@ subroutine FAST_PackOutputFileType(Buf, Indata) call FAST_PackLinFileType(Buf, InData%Lin) call RegPack(Buf, InData%ActualChanLen) call FAST_PackLinStateSave(Buf, InData%op) - call RegPack(Buf, InData%DriverWriteOutput) + 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 + 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 + 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 @@ -8533,8 +8593,48 @@ subroutine FAST_UnPackOutputFileType(Buf, OutData) call RegUnpack(Buf, OutData%ActualChanLen) if (RegCheckErr(Buf, RoutineName)) return call FAST_UnpackLinStateSave(Buf, OutData%op) ! op - call RegUnpack(Buf, OutData%DriverWriteOutput) + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 5bc3b22acf..cc658c0a57 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -200,6 +200,17 @@ subroutine Solver_Init(p, m, Mods, Turbine, ErrStat, ErrMsg) p%C(6) = p%DT*(1.0_R8Ki - p%Gamma) p%C(7) = p%DT*p%Gamma + !---------------------------------------------------------------------------- + ! Solver Outputs + !---------------------------------------------------------------------------- + + call AllocAry(Turbine%y_FAST%WriteOutput, 3, 'y_FAST%WriteOutput', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Turbine%y_FAST%WriteOutputHdr, 3, 'y_FAST%WriteOutputHdr', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Turbine%y_FAST%WriteOutputUnt, 3, 'y_FAST%WriteOutputUnit', ErrStat2, ErrMsg2); if (Failed()) return + + Turbine%y_FAST%WriteOutputHdr = [character(ChanLen) :: 'ConvIter', 'ConvError', 'NumUJac'] + Turbine%y_FAST%WriteOutputUnt = [character(ChanLen) :: '(-)', '(-)', '(-)'] + !---------------------------------------------------------------------------- ! Write debug info to file !---------------------------------------------------------------------------- @@ -521,7 +532,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) logical, parameter :: IsSolve = .true. integer(IntKi) :: i, j, k real(R8Ki), allocatable :: accel(:) - real(R8Ki) :: diff + real(R8Ki) :: ConvError logical :: converged integer(IntKi), parameter :: n_t_global = -1 ! loop counter integer(IntKi), parameter :: n_t_global_next = 0 ! loop counter @@ -563,7 +574,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Loop until initial accelerations are converged, or max iterations are reached. ! TODO: may need a separate variable for max initial acceleration convergence iterations converged = .false. - k = 1 + k = 0 do while ((.not. converged) .and. (k <= 2*p%MaxConvIter)) ! Transfer inputs and calculate outputs for all modules (use current state) @@ -587,11 +598,11 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) if (p%ixqd(3, i) == COL_V) accel(p%ixqd(2, i)) = m%dxdt(p%ixqd(1, i)) end do - ! Calculate diff as L2 norm of current and new accelerations - diff = TwoNorm(accel - m%qn(:, COL_A)) + ! Calculate convergence error as L2 norm of diff between current and new accelerations + ConvError = TwoNorm(accel - m%qn(:, COL_A)) - ! If difference is less than converence tolerance, set flag and exit loop - if ((k > 1) .and. (diff < p%ConvTol)) converged = .true. + ! If difference is less than convergence tolerance, set flag and exit loop + if ((k > 1) .and. (ConvError < p%ConvTol)) converged = .true. ! Update acceleration in q matrix m%qn(:, COL_A) = accel @@ -602,7 +613,7 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Print warning if not converged if (.not. converged) call WrScr("Solver: initial accel not converged, diff="// & - trim(Num2LStr(diff))//", tol="//trim(Num2LStr(p%ConvTol))) + trim(Num2LStr(ConvError))//", tol="//trim(Num2LStr(p%ConvTol))) ! Initialize algorithmic acceleration from actual acceleration m%qn(:, COL_AA) = m%qn(:, COL_A) @@ -618,6 +629,14 @@ subroutine Solver_Step0(p, m, Mods, Turbine, ErrStat, ErrMsg) ! Reset the Remap flags for all modules call FAST_ResetRemapFlags(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + !---------------------------------------------------------------------------- + ! Set Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%WriteOutput(1) = real(k, ReKi) ! ConvIter + Turbine%y_FAST%WriteOutput(2) = real(ConvError, ReKi) ! ConvError + Turbine%y_FAST%WriteOutput(3) = 0.0_ReKi ! NumUJac + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -639,11 +658,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 logical, parameter :: IsSolve = .true. - integer(IntKi) :: iterConv, iterCorr, NumCorrections + integer(IntKi) :: iterConv, iterCorr, iterTotal + integer(IntKi) :: NumUJac, NumCorrections real(ReKi) :: delta_norm - real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - integer(IntKi) :: n_t_global_next ! n_t_global + 1 + real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + integer(IntKi) :: n_t_global_next ! n_t_global + 1 integer(IntKi) :: i, j + logical :: ConvUJac ! Jacobian updated for convergence ErrStat = ErrID_None ErrMsg = '' @@ -662,6 +683,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 + ! Set Jacobian updated for convergence flag to false + ConvUJac = .false. + + ! Init counters for number of Jacobian updates and number of convergence iterations + NumUJac = 0 + iterTotal = 0 + !---------------------------------------------------------------------------- ! Extrapolate/interpolate inputs for all modules !---------------------------------------------------------------------------- @@ -772,6 +800,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Loop through convergence iterations do iterConv = 0, p%MaxConvIter + ! Increment total number of convergence iterations in step + iterTotal = iterTotal + 1 + ! Decrement number of iterations before updating the Jacobian m%IterUntilUJac = m%IterUntilUJac - 1 @@ -785,30 +816,37 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do !---------------------------------------------------------------------- - ! If iteration limit reached, exit loop + ! Convergence iteration check !---------------------------------------------------------------------- + ! If convergence iteration has reached or exceeded limit if (iterConv >= p%MaxConvIter) then - ! If number of corrections is less than or the same as limit, - ! increase number of corrections and set counter to trigger - ! a Jacobian update on correction step. - if (NumCorrections <= p%NumCrctn) then - NumCorrections = NumCorrections + 1 + ! If Jacobian has not been updated for convergence + if (.not. ConvUJac) then + + ! Set counter to trigger a Jacobian update on next convergence iteration m%IterUntilUJac = 0 - else if (m%ConvWarn) then + ! If at the maximum number of correction iterations, + ! increase limit to retry the step after the Jacobian is updated + if (iterCorr == NumCorrections) NumCorrections = NumCorrections + 1 - ! Otherwise, warn that convergence failed + ! Set flag indicating that the jacobian has been updated for convergence + ConvUJac = .true. + + else + + ! Otherwise, correction iteration with Jacobian update has been tried, + ! display warning that convergence failed and move to next step call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & " iterations on step "//trim(Num2LStr(n_t_global_next))// & " (error="//trim(Num2LStr(delta_norm))// & ", tolerance="//trim(Num2LStr(p%ConvTol))// & "). Warning will not be displayed again.", ErrStat, ErrMsg, RoutineName) - m%ConvWarn = .false. end if - ! Exit loop + ! Exit convergence loop to next correction iteration or next step exit end if @@ -820,6 +858,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! is zero or less, or first solution step, then rebuild the Jacobian. ! Note: BuildJacobian resets these counters. if ((m%IterUntilUJac <= 0) .or. (m%StepsUntilUJac <= 0) .or. (n_t_global_next == 1)) then + NumUJac = NumUJac + 1 call BuildJacobian(p, m, Mods, t_global_next, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end if @@ -840,8 +879,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Transfer Option 1 outputs to temporary inputs and collect into u_tmp do i = 1, size(p%iModOpt1) - call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, IS_u, & - Turbine, ErrStat2, ErrMsg2) + call FAST_InputSolve(Mods(p%iModOpt1(i)), m%Mappings, IS_u, Turbine, ErrStat2, ErrMsg2) if (Failed()) return end do call PackModuleUs(Mods, p%iModOpt1, Turbine, m%u_tmp) @@ -894,7 +932,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Update state matrix with deltas m%qn = m%qn + m%dq - ! Transfer change in q state matrix to change in x array + ! Transfer change in q state matrix to change in x state array m%dx = 0.0_R8Ki call TransferQtoX(p%ixqd, m%dq, m%dx) @@ -922,15 +960,18 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do + ! Increment correction iteration counter iterCorr = iterCorr + 1 - ! Perform input solve for modules post Option 1 + ! Perform input solve for modules post Option 1 convergence do i = 1, size(p%iModPost) - call FAST_InputSolve(Mods(p%iModPost(i)), m%Mappings, IS_Input, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_InputSolve(Mods(p%iModPost(i)), m%Mappings, IS_Input, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return end do ! Reset mesh remap - call FAST_ResetRemapFlags(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_ResetRemapFlags(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return end do !---------------------------------------------------------------------------- @@ -942,13 +983,25 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Copy the final predicted states from step t_global_next to actual states for that step do i = 1, size(Mods) - call FAST_SaveStates(Mods(i), Turbine, ErrStat2, ErrMsg2); if (Failed()) return + call FAST_SaveStates(Mods(i), Turbine, ErrStat2, ErrMsg2) + if (Failed()) return end do ! Save new state m%x = m%xn + !---------------------------------------------------------------------------- + ! Set Outputs + !---------------------------------------------------------------------------- + + Turbine%y_FAST%WriteOutput(1) = real(iterTotal, ReKi) ! ConvIter + Turbine%y_FAST%WriteOutput(2) = real(delta_norm, ReKi) ! ConvError + Turbine%y_FAST%WriteOutput(3) = real(NumUJac, ReKi) ! NumUJac + + !---------------------------------------------------------------------------- ! Update the global time + !---------------------------------------------------------------------------- + Turbine%m_FAST%t_global = t_global_next contains From 1d94347696043b7d83ab10539a9f792187b87c84 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 22 Sep 2023 20:29:26 +0000 Subject: [PATCH 53/61] TC: mesh transfer order: motion comes before loads --- modules/openfast-library/src/FAST_Eval.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 81085017e5..41730ad0ac 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -645,6 +645,11 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Get module indices in ModData and determine which mappings are active !---------------------------------------------------------------------------- + ! Reorder the mappings so that motion maps come before the load maps + Maps = [pack(Maps, Maps%Typ == Map_MotionMesh), & + pack(Maps, Maps%Typ == Map_LoadMesh), & + pack(Maps, Maps%Typ == Map_NonMesh)] + ! Loop through mappings do iMap = 1, size(Maps) associate (Map => Maps(iMap), & From 5270bf8540e89d50701c9fb604c4cec71bfe2e1a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 27 Sep 2023 16:09:23 +0000 Subject: [PATCH 54/61] BD_JacobianPInput: skip rotate states if IsSolve=T --- modules/beamdyn/src/BeamDyn.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 27bf591e24..07361f9736 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -6196,7 +6196,7 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call BD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - if (p%RotStates) then + if ((.not. IsSolveLoc) .and. p%RotStates) then RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) do i=1,size(dXdu,1),3 dXdu(i:i+2, :) = matmul( RotateStates, dXdu(i:i+2, :) ) @@ -6284,7 +6284,7 @@ SUBROUTINE BD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, call BD_JacobianPContState_noRotate(t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2, dYdx, dXdx, IsSolveLoc); if (Failed()) return ! If states need to be rotated - if (.not. IsSolveLoc .and. p%RotStates) then + if ((.not. IsSolveLoc) .and. p%RotStates) then RotateStates = matmul( u%RootMotion%Orientation(:,:,1), transpose( u%RootMotion%RefOrientation(:,:,1) ) ) RotateStatesTranspose = transpose( RotateStates ) From e126ce850a3623dbf6fa6c3d7ac6e361a9b4aa30 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 27 Sep 2023 16:10:13 +0000 Subject: [PATCH 55/61] Remove check in FAST_LinearizeMappings, add TODO --- modules/openfast-library/src/FAST_Eval.f90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index 41730ad0ac..c795d9d1b8 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -2080,9 +2080,7 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Maps, T, ErrStat, ErrMsg, d ! If source or destination modules are not in tight coupling ! or mapping is non-mesh, cycle - if ((.not. ModData(Maps(i)%DstModIdx)%IsTC) .or. & - (.not. ModData(Maps(i)%SrcModIdx)%IsTC) .or. & - (Maps(i)%Typ == Map_NonMesh)) cycle + if (Maps(i)%Typ == Map_NonMesh) cycle ! Select based on mapping Key select case (Maps(i)%Key) @@ -2102,8 +2100,9 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Maps, T, ErrStat, ErrMsg, d if (Failed()) return case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) - return + cycle ! TODO: remove cycle and restore error, all mapping should be linearized + ! call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + ! return end select if (present(dUdu)) then @@ -2117,9 +2116,9 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Maps, T, ErrStat, ErrMsg, d contains subroutine dUduSetBlocks(M, SrcMod, DstMod, MML) - type(TC_MappingType), intent(inout) :: M !< Mapping - type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data - type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data + type(TC_MappingType), intent(inout) :: M !< Mapping + type(ModDataType), intent(in) :: SrcMod, DstMod !< Module data + type(MeshMapLinearizationType), intent(in) :: MML !< Mesh Map Linearization data ! Effect of input Translation Velocity on input Translation Displacement if (allocated(MML%tv_uD)) then @@ -2153,7 +2152,7 @@ subroutine dUdySetBlocks(M, SrcMod, DstMod, MML) call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, SrcMod%Vars%y(M%SrcVarIdx), VF_Force, -MML%m_f, dUdy) end if - ! Moment to output translation displacement + ! Moment to destination translation displacement if (allocated(Maps(i)%MeshMap%dM%m_uD)) then call SetBlock(DstMod%Vars%u(M%DstVarIdx), VF_Moment, DstMod%Vars%y([M%DstDispVarIdx]), VF_TransDisp, -MML%m_uD, dUdy) end if From e4b7dc0cd24e0b60ea5030f115dd9e3ce8120c42 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 27 Sep 2023 16:11:56 +0000 Subject: [PATCH 56/61] Solver.f90: fix warning, Jacobian negative sign --- modules/openfast-library/src/Solver.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index cc658c0a57..8db1d90c86 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -842,8 +842,8 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & " iterations on step "//trim(Num2LStr(n_t_global_next))// & " (error="//trim(Num2LStr(delta_norm))// & - ", tolerance="//trim(Num2LStr(p%ConvTol))// & - "). Warning will not be displayed again.", ErrStat, ErrMsg, RoutineName) + ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ErrStat, ErrMsg, RoutineName) end if ! Exit convergence loop to next correction iteration or next step @@ -875,7 +875,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM end do ! Calculate difference between predicted and actual accelerations - m%XB(p%iJX(1):p%iJX(2), 1) = m%qn(:, COL_A) - m%dxdt(p%iX2(1):p%iX2(2)) + m%XB(p%iJX(1):p%iJX(2), 1) = m%dxdt(p%iX2(1):p%iX2(2)) - m%qn(:, COL_A) ! Transfer Option 1 outputs to temporary inputs and collect into u_tmp do i = 1, size(p%iModOpt1) @@ -887,7 +887,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Calculate difference in U for all Option 1 modules (un - u_tmp) ! and add to RHS for TC and Option 1 modules call ComputeDeltaU(Mods, p%iModOpt1, m%un, m%u_tmp, m%UDiff) - m%XB(p%iJU(1):p%iJU(2), 1) = m%UDiff + m%XB(p%iJU(1):p%iJU(2), 1) = -m%UDiff ! Apply conditioning factor to loads in RHS m%XB(p%iJL, 1) = m%XB(p%iJL, 1)/p%Scale_UJac @@ -924,10 +924,10 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- ! Calculate change in state matrix - m%dq(:, COL_D) = -p%C(3)*m%XB(p%iJX(1):p%iJX(2), 1) - m%dq(:, COL_V) = -p%C(2)*m%XB(p%iJX(1):p%iJX(2), 1) - m%dq(:, COL_A) = -m%XB(p%iJX(1):p%iJX(2), 1) - m%dq(:, COL_AA) = -p%C(1)*m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_D) = p%C(3)*m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_V) = p%C(2)*m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_A) = m%XB(p%iJX(1):p%iJX(2), 1) + m%dq(:, COL_AA) = p%C(1)*m%XB(p%iJX(1):p%iJX(2), 1) ! Update state matrix with deltas m%qn = m%qn + m%dq @@ -950,7 +950,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM !---------------------------------------------------------------------- ! Update change in inputs - m%du = -m%XB(p%iJU(1):p%iJU(2), 1) + m%du = m%XB(p%iJU(1):p%iJU(2), 1) ! Apply deltas to inputs, update modules call AddDeltaToInputs(Mods, p%iModOpt1, m%du, m%un) From 98d02241b7d885ad8e9770d65ba910f72491a1bc Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 3 Oct 2023 16:47:06 +0000 Subject: [PATCH 57/61] Revised mesh mapping spec, added SubDyn --- modules/aerodyn/src/AeroDyn.f90 | 30 +- modules/beamdyn/src/BeamDyn.f90 | 14 +- modules/elastodyn/src/ElastoDyn.f90 | 101 +- modules/hydrodyn/src/HydroDyn.f90 | 637 ++++++++----- modules/hydrodyn/src/HydroDyn.txt | 7 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 87 ++ modules/nwtc-library/src/ModMesh.f90 | 8 +- modules/nwtc-library/src/ModMesh_Types.f90 | 1 + modules/nwtc-library/src/ModVar.f90 | 59 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 13 +- .../src/Registry_NWTC_Library.txt | 3 +- .../src/Registry_NWTC_Library_base.txt | 3 +- modules/openfast-library/src/FAST_Eval.f90 | 899 +++++++++++------- .../openfast-library/src/FAST_Registry.txt | 33 +- modules/openfast-library/src/FAST_Subs_TC.f90 | 12 + modules/openfast-library/src/FAST_Types.f90 | 72 +- modules/openfast-library/src/Solver.f90 | 102 +- modules/seastate/src/SeaState.f90 | 69 ++ modules/seastate/src/SeaState.txt | 7 +- modules/seastate/src/SeaState_Types.f90 | 84 ++ modules/subdyn/src/SubDyn.f90 | 537 +++++++---- 21 files changed, 1819 insertions(+), 959 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 26af73dfb8..ca6b68bd06 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -611,9 +611,9 @@ end subroutine AD_ReInit !> This routine initializes module variables for use by the solver and linearization. subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) TYPE(AD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(AD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(AD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(AD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(AD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -657,30 +657,30 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) ! Add tower motion call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"TowerMotion", & - Nodes=ru%TowerMotion%NNodes, & + Mesh=ru%TowerMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel]) ! Add nacelle motion call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"NacelleMotion", & - Nodes=ru%NacelleMotion%NNodes, & + Mesh=ru%NacelleMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel]) ! Add hub motion call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"HubMotion", & - Nodes=ru%HubMotion%NNodes, & + Mesh=ru%HubMotion, & Fields=[VF_TransDisp, VF_Orientation, VF_AngularVel]) ! Add blade root motion do j = 1, rp%NumBlades call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"BladeRootMotion"//IdxStr(j), & - Nodes=ru%BladeRootMotion(j)%NNodes, & + Mesh=ru%BladeRootMotion(j), & Fields=[VF_Orientation]) end do ! Add blade motion do j = 1, rp%NumBlades call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"BladeMotion"//IdxStr(j), & - Nodes=ru%BladeMotion(j)%NNodes, & + Mesh=ru%BladeMotion(j), & Fields=[VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc]) end do @@ -696,23 +696,17 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) !---------------------------------------------------------------------- ! Add tower load - call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"TowerLoad", LoadFields, & - Nodes=ry%TowerLoad%NNodes) + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"TowerLoad", LoadFields, Mesh=ry%TowerLoad) ! Add nacelle load - call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"HubLoad", LoadFields, & - Nodes=ry%HubLoad%NNodes) + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"HubLoad", LoadFields, Mesh=ry%HubLoad) ! Add nacelle load - call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"NacelleLoad", LoadFields, & - Nodes=ry%NacelleLoad%NNodes) + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"NacelleLoad", LoadFields, Mesh=ry%NacelleLoad) - ! Loop through blades + ! Loop through blades, add blade loads do j = 1, rp%NumBlades - - ! Add blade load - call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"BladeLoad"//IdxStr(j), LoadFields, & - Nodes=ry%BladeLoad(j)%NNodes) + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"BladeLoad"//IdxStr(j), LoadFields, Mesh=ry%BladeLoad(j)) end do ! Rotor outputs diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 07361f9736..e4dfa31c23 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -276,9 +276,9 @@ END SUBROUTINE BD_Init subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) TYPE(BD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(BD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(BD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(BD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(BD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(BD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -357,7 +357,7 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) MaxTorque = 14.0_R8Ki*p%blade_length**3 call MV_AddMeshVar(p%Vars%u, "RootMotion", MotionFields, & - Nodes=u%RootMotion%Nnodes, & + Mesh=u%RootMotion, & Perturbs=[0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransDisp 0.2_R8Ki*D2R_D, & ! VF_Orientation 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransVel @@ -365,11 +365,11 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) 0.2_R8Ki*D2R_D * p%blade_length, & ! VF_TransAcc 0.2_R8Ki*D2R_D]) ! VF_AngularAcc call MV_AddMeshVar(p%Vars%u, "PointLoad", LoadFields, & - Nodes=u%PointLoad%Nnodes, & + Mesh=u%PointLoad, & Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment call MV_AddMeshVar(p%Vars%u, "DistrLoad", LoadFields, Flags=VF_Line, & - Nodes=u%DistrLoad%Nnodes, & + Mesh=u%DistrLoad, & Perturbs=[MaxThrust/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes), & ! VF_Force MaxTorque/(100.0_R8Ki*3.0_R8Ki*u%PointLoad%Nnodes)]) ! VF_Moment @@ -377,8 +377,8 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) ! Output variables !---------------------------------------------------------------------------- - call MV_AddMeshVar(p%Vars%y, 'ReactionForce', LoadFields, Nodes=y%ReactionForce%Nnodes) - call MV_AddMeshVar(p%Vars%y, 'BladeMotion', MotionFields, Nodes=y%BldMotion%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'ReactionForce', LoadFields, Mesh=y%ReactionForce) + call MV_AddMeshVar(p%Vars%y, 'BladeMotion', MotionFields, Mesh=y%BldMotion) do i = 1, p%NumOuts call MV_AddVar(p%Vars%y, p%OutParam(i)%Name, VF_Scalar, & Flags=OutParamFlags(p%OutParam(i)%Indx), & diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 8af355edf0..e6ea1b341b 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -371,9 +371,9 @@ END SUBROUTINE ED_Init !---------------------------------------------------------------------------------------------------------------------------------- subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ErrMsg) TYPE(ED_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(ED_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(ED_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(ED_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(ED_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(ED_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine TYPE(ED_InputFile), INTENT(IN ) :: InputFileData !< Input file data @@ -546,31 +546,30 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, if (allocated(u%BladePtLoads)) then do i = 1, p%NumBl call MV_AddMeshVar(p%Vars%u, "BladeLoad"//IdxStr(i), LoadFields, & - Nodes=p%BldNodes, & + Mesh=u%BladePtLoads(i), & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%BldNodes), & - MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)], & - Active=u%BladePtLoads(i)%committed) + MaxTorque / (100.0_R8Ki*p%NumBl*p%BldNodes)]) end do end if ! Platform point loads call MV_AddMeshVar(p%Vars%u, "PlatformLoad", LoadFields, & - Nodes=u%PlatformPtMesh%NNodes, & + Mesh=u%PlatformPtMesh, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Tower point loads call MV_AddMeshVar(p%Vars%u, "TowerLoad", LoadFields, & - Nodes=u%TowerPtLoads%Nnodes, & + Mesh=u%TowerPtLoads, & Perturbs=[MaxThrust / (100.0_R8Ki*p%NumBl*p%TwrNodes), & MaxTorque / (100.0_R8Ki*p%NumBl*p%TwrNodes)]) ! Hub point loads call MV_AddMeshVar(p%Vars%u, "HubLoad", LoadFields, & - Nodes=u%HubPtLoad%NNodes, & + Mesh=u%HubPtLoad, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Nacelle point loads call MV_AddMeshVar(p%Vars%u, "NacelleLoad", LoadFields, & - Nodes=u%NacelleLoads%NNodes, & + Mesh=u%NacelleLoads, & Perturbs=[MaxThrust / 100.0_R8Ki, & MaxTorque / 100.0_R8Ki]) ! Non-mesh input variables @@ -600,16 +599,16 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, if (allocated(y%BladeLn2Mesh))then do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'BladeMotion'//IdxStr(i), MotionFields, Nodes=y%BladeLn2Mesh(i)%Nnodes, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'BladeMotion'//IdxStr(i), MotionFields, Mesh=y%BladeLn2Mesh(i), Flags=VF_Line) end do end if - call MV_AddMeshVar(p%Vars%y, 'PlatformMotion', MotionFields, Nodes=y%PlatformPtMesh%Nnodes) - call MV_AddMeshVar(p%Vars%y, 'TowerMotion', MotionFields, Nodes=y%TowerLn2Mesh%Nnodes, Flags=VF_Line) - call MV_AddMeshVar(p%Vars%y, 'HubMotion', [VF_TransDisp, VF_Orientation, VF_AngularVel], Nodes=y%HubPtMotion%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'PlatformMotion', MotionFields, Mesh=y%PlatformPtMesh) + call MV_AddMeshVar(p%Vars%y, 'TowerMotion', MotionFields, Mesh=y%TowerLn2Mesh, Flags=VF_Line) + call MV_AddMeshVar(p%Vars%y, 'HubMotion', [VF_TransDisp, VF_Orientation, VF_AngularVel], Mesh=y%HubPtMotion) do i = 1, p%NumBl - call MV_AddMeshVar(p%Vars%y, 'BladeRootMotion'//IdxStr(i), MotionFields, Nodes=y%BladeRootMotion(i)%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'BladeRootMotion'//IdxStr(i), MotionFields, Mesh=y%BladeRootMotion(i)) end do - call MV_AddMeshVar(p%Vars%y, 'NacelleMotion', MotionFields, Nodes=y%NacelleMotion%Nnodes) + call MV_AddMeshVar(p%Vars%y, 'NacelleMotion', MotionFields, Mesh=y%NacelleMotion) call MV_AddVar(p%Vars%y, 'Yaw', VF_AngularDisp, LinNames=['Yaw, rad']) call MV_AddVar(p%Vars%y, 'YawRate', VF_Scalar, LinNames=['YawRate, rad/s']) call MV_AddVar(p%Vars%y, 'HSS_Spd', VF_Scalar, LinNames=['HSS_Spd, rad/s']) @@ -957,7 +956,7 @@ SUBROUTINE ED_UpdateAzimuth(p, x, DT) !! NOTE: no matter how many channels are selected for output, all of the outputs are calculated !! All of the calculated output channels are placed into the m\%AllOuts(:), while the channels selected for outputs are !! placed in the y\%WriteOutput(:) array. -SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, yarr ) +SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -972,7 +971,6 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), OPTIONAL, INTENT(INOUT) :: yarr(:) !< Optional array for packing output ! Local variables: @@ -2328,13 +2326,6 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, y%LSShftFys = m%AllOuts(LSShftFys)*1000. ! Nonrotating low-speed shaft force y (GL co-ords) (N) y%LSShftFzs = m%AllOuts(LSShftFzs)*1000. ! Nonrotating low-speed shaft force z (GL co-ords) (N) - - ! If output array is present, pack output data - if (present(yarr)) then - call ED_PackOutputValues(p, y, yarr) - end if - - END SUBROUTINE ED_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states. @@ -10685,9 +10676,6 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' - - - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' @@ -10699,13 +10687,13 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM IsSolveLoc = .false. end if - ! make a copy of the inputs to perturb + ! make a copy of the inputs to perturb call ED_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! Pack operating point input values for perturbations + ! Pack operating point input values for perturbations call ED_PackInputValues(p, u, m%Vals%u) - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: IF ( PRESENT( dYdu ) ) THEN ! allocate dYdu if necessary @@ -10728,12 +10716,14 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Calculate positive perturbation call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) - call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp); if (Failed()) return + call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, y_p, m%Vals%yp) ! Calculate negative perturbation call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) call ED_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) - call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn); if (Failed()) return + call ED_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, y_p, m%Vals%yn) ! Get partial derivative via central difference call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdu(:,k)) @@ -10742,12 +10732,8 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Extended: BlPitchComC is the sum of BlPitchCom across all blades dYdu(:,p%Vars%u(p%iBlPitchComCVar)%iLoc(1)) = sum(dYdu(:,p%Vars%u(p%iBlPitchCoModVarType)%iLoc), dim=2) - - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - - END IF + end if - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: IF ( PRESENT( dXdu ) ) THEN @@ -10783,19 +10769,16 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do ! Extended: BlPitchComC is the sum of BlPitchCom across all blades - dXdu(:,p%Vars%u(p%iBlPitchComCVar)%iLoc(1)) = sum(dXdu(:,p%Vars%u(p%iBlPitchCoModVarType)%iLoc), dim=2) - - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF + dXdu(:,p%Vars%u(p%iBlPitchComCVar)%iLoc(1)) = sum(dXdu(:,p%Vars%u(p%iBlPitchCoModVarType)%iLoc), dim=2) + end if - IF ( PRESENT( dXddu ) ) THEN + if ( present( dXddu ) ) then if (allocated(dXddu)) deallocate(dXddu) - END IF + end if - IF ( PRESENT( dZdu ) ) THEN + if ( present( dZdu ) ) then if (allocated(dZdu)) deallocate(dZdu) - END IF + end if call cleanup() @@ -10866,13 +10849,13 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, IsSolveLoc = .false. end if - ! Pack operating point state values for perturbations + ! Pack operating point state values for perturbations call ED_PackStateValues(p, x, m%Vals%x) - ! make a copy of the continuous states to perturb + ! make a copy of the continuous states to perturb call ED_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: IF ( PRESENT( dYdx ) ) THEN ! allocate dYdx if necessary @@ -10881,7 +10864,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if ! make a copy of outputs for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ED_CopyOutput(y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! Loop through state variables do i = 1,size(p%Vars%x) @@ -10895,26 +10878,24 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! Calculate positive perturbation call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) - call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yp); if (Failed()) return + call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, y_p, m%Vals%yp) ! Calculate negative perturbation call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) call ED_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) - call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2, m%Vals%yn); if (Failed()) return + call ED_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call ED_PackOutputValues(p, y_p, m%Vals%yn) ! Get partial derivative via central difference call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdx(:,k)) end do end do - - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF + end if + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! allocate dXdx if necessary if (.not. allocated(dXdx)) then call AllocAry(dXdx, p%Vars%Nx, p%Vars%Nx, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return @@ -10945,9 +10926,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, dXdx(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do - - call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF + end if IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 1fe48f7e65..29deb90e69 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -73,6 +73,8 @@ MODULE HydroDyn ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) PUBLIC :: HD_GetOP !< Routine to pack the operating point values (for linearization) into arrays + PUBLIC :: HD_PackStateValues, HD_PackInputValues, HD_PackOutputValues + PUBLIC :: HD_UnpackStateValues, HD_UnpackInputValues CONTAINS @@ -868,14 +870,24 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Define initialization-routine output here: InitOut%Ver = HydroDyn_ProgDesc + !............................................................................................ + ! Module Variables + !............................................................................................ + + call Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUp() + return + end if !............................................................................................ ! Initialize Jacobian: !............................................................................................ - if (InitInp%Linearize) then - call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + ! if (InitInp%Linearize) then + ! call HD_Init_Jacobian( p, u, y, InitOut, ErrStat2, ErrMsg2) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! end if IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! @@ -899,6 +911,248 @@ END SUBROUTINE CleanUp !................................ END SUBROUTINE HydroDyn_Init +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ErrMsg) + TYPE(HydroDyn_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + TYPE(HydroDyn_InputFile), INTENT(IN ) :: InputFileData !< Input file data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + INTEGER(IntKi) :: i, j, k, idx, spdof + REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + REAL(R8Ki) :: perturb_t, perturb + CHARACTER(10), PARAMETER :: dofLabels(6) = [& + 'PtfmSg', 'PtfmSw', 'PtfmHv', 'PtfmR ', 'PtfmP ', 'PtfmY '] + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Associate pointers in initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! Need to determine how many wamit body objects there are + p%totalExctnStates = 0 + p%totalRdtnStates = 0 + do j = 1, p%nWAMITObj + p%totalExctnStates = p%totalExctnStates + p%WAMIT(j)%SS_Exctn%numStates !numStates defaults to zero in the case where ExctnMod = 0 instead of 2 + p%totalRdtnStates = p%totalRdtnStates + p%WAMIT(j)%SS_Rdtn%numStates !numStates defaults to zero in the case where RdtnMod = 0 instead of 2 + end do + p%totalStates = p%totalExctnStates + p%totalRdtnStates + + ! SS_Exctn states + idx = 1 + do i = 1, p%nWAMITObj + if (p%WAMIT(i)%SS_Exctn%numStates == 0) cycle + if (p%NBodyMod == 1) then + call MV_AddVar(p%Vars%x, "SS_Exctn"//Num2LStr(i), VF_Scalar, & + iUsr=i, jUsr=1, & + Num=p%WAMIT(i)%SS_Exctn%numStates, & + Perturb=20000.0_R8Ki * D2R_D, & + LinNames=[(('Exctn'//trim(dofLabels(j))//trim(num2lstr(k)), k=1,p%WAMIT(i)%SS_Exctn%spdof(j)), j=1,6)]) + else + call MV_AddVar(p%Vars%x, "SS_Exctn"//Num2LStr(i), VF_Scalar, & + iUsr=i, jUsr=1, & + Num=p%WAMIT(i)%SS_Exctn%numStates, & + Perturb=20000.0_R8Ki * D2R_D, & + LinNames=[(('B'//trim(num2lstr(i))//'Exctn'//trim(dofLabels(j))//trim(num2lstr(k)), k=1,p%WAMIT(i)%SS_Exctn%spdof(j)), j=1,6)]) + end if + end do + + ! SS_Rdtn states + do i = 1, p%nWAMITObj + if (p%WAMIT(i)%SS_Rdtn%numStates == 0) cycle + if (p%NBodyMod == 1) then + call MV_AddVar(p%Vars%x, "SS_Rdtn"//Num2LStr(i), VF_Scalar, & + iUsr=i, jUsr=2, & + Num=spdof, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=[(('Rdtn'//trim(dofLabels(j))//trim(num2lstr(k)), k=1,p%WAMIT(i)%SS_Rdtn%spdof(j)), j=1,6)]) + else + call MV_AddVar(p%Vars%x, "SS_Rdtn"//Num2LStr(i), VF_Scalar, & + iUsr=i, jUsr=2, & + Num=spdof, & + Perturb=2.0_R8Ki * D2R_D, & + LinNames=[(('B'//trim(num2lstr(i))//'Rdtn'//trim(dofLabels(j))//trim(num2lstr(k)), k=1,p%WAMIT(i)%SS_Rdtn%spdof(j)), j=1,6)]) + end if + end do + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + perturb_t = 0.02_ReKi*D2R * max(p%WtrDpth,1.0_ReKi) ! translation input scaling + perturb = 2*D2R ! rotational input scaling + + ! Mesh Motions + call MV_AddMeshVar(p%Vars%u, "Morison", MotionFields, Mesh=u%Morison%Mesh, & + Perturbs=[perturb_t, perturb, perturb_t, perturb, perturb_t, perturb]) + call MV_AddMeshVar(p%Vars%u, "WAMIT", MotionFields, Mesh=u%WAMITMesh, & + Perturbs=[perturb_t, perturb, perturb_t, perturb, perturb_t, perturb]) + call MV_AddMeshVar(p%Vars%u, "Platform-RefPt", MotionFields, Mesh=u%PRPMesh, & + Perturbs=[perturb_t, perturb, perturb_t, perturb, perturb_t, perturb]) + + ! Extended input + call MV_AddVar(p%Vars%u, "Wave Elevation", VF_Scalar, Flags=VF_Ext, & + LinNames=['Extended input: wave elevation at platform ref point, m']) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Mesh Loads + call MV_AddMeshVar(p%Vars%y, "MorisonLoads", LoadFields, Mesh=y%Morison%Mesh) + call MV_AddMeshVar(p%Vars%y, "WAMITLoads", LoadFields, Mesh=y%WAMITMesh) + + ! Module outputs + do i = 1, p%NumTotalOuts + call MV_AddVar(p%Vars%y, InitOut%WriteOutputHdr(i), VF_Scalar, iUsr=i, & + LinNames=[trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i))]) + end do + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + if (.not. InitInp%Linearize) return + + ! State Variables + CALL AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + InitOut%DerivOrder_x = 1 + do i = 1, size(p%Vars%x) + do j = 1, p%Vars%x(i)%Num + InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames + end do + end do + + ! Input Variables + call AllocAry(InitOut%LinNames_u, p%Vars%Nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, p%Vars%Nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%u) + do j = 1, p%Vars%u(i)%Num + InitOut%LinNames_u(p%Vars%u(i)%iLoc) = p%Vars%u(i)%LinNames + InitOut%IsLoad_u(p%Vars%u(i)%iLoc) = iand(p%Vars%u(i)%Field, VF_Force+VF_Moment) > 0 + end do + end do + + ! Output variables + CALL AllocAry(InitOut%LinNames_y, p%Vars%Ny, 'LinNames_y', ErrStat2, ErrMsg2); if (Failed()) return + if (ErrStat >= AbortErrLev) return + do i = 1, size(p%Vars%y) + do j = 1, p%Vars%y(i)%Num + InitOut%LinNames_y(p%Vars%y(i)%iLoc) = p%Vars%y(i)%LinNames + end do + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +subroutine HD_PackStateValues(p, x, ary) + type(HydroDyn_ParameterType), intent(in) :: p + type(HydroDyn_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i, iv + do i = 1, p%nWAMITObj + call MV_PackVar(p%Vars%x, iv, x%WAMIT(i)%SS_Exctn%x(1:p%WAMIT(i)%SS_Exctn%numStates), ary) + end do + do i = 1, p%nWAMITObj + call MV_PackVar(p%Vars%x, iv, x%WAMIT(i)%SS_Rdtn%x(1:p%WAMIT(i)%SS_Rdtn%numStates), ary) + end do +end subroutine + +subroutine HD_UnpackStateValues(p, ary, x) + type(HydroDyn_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(HydroDyn_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i, iv + do i = 1, p%nWAMITObj + call MV_UnpackVar(p%Vars%x, iv, ary, x%WAMIT(i)%SS_Exctn%x(1:p%WAMIT(i)%SS_Exctn%numStates)) + end do + do i = 1, p%nWAMITObj + call MV_UnpackVar(p%Vars%x, iv, ary, x%WAMIT(i)%SS_Rdtn%x(1:p%WAMIT(i)%SS_Rdtn%numStates)) + end do +end subroutine + +subroutine HD_PackInputValues(p, u, ary) + type(HydroDyn_ParameterType), intent(in) :: p + type(HydroDyn_InputType), intent(in) :: u + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + if (u%Morison%Mesh%Committed) then + call MV_PackMesh(p%Vars%u, iv, u%Morison%Mesh, ary) + end if + if (u%WAMITMesh%Committed) then + call MV_PackMesh(p%Vars%u, iv, u%WAMITMesh, ary) + end if + call MV_PackMesh(p%Vars%u, iv, u%PRPMesh, ary) + + ! extended input + call MV_PackVar(p%Vars%u, iv, 0.0, ary) ! u%WaveElev0 +end subroutine + +subroutine HD_UnpackInputValues(p, ary, u) + type(HydroDyn_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(HydroDyn_InputType), intent(inout) :: u + integer(IntKi) :: iv, i + iv = 1 + if (u%Morison%Mesh%Committed) then + call MV_UnpackMesh(p%Vars%u, iv, ary, u%Morison%Mesh) + end if + if (u%WAMITMesh%Committed) then + call MV_UnpackMesh(p%Vars%u, iv, ary, u%WAMITMesh) + end if + call MV_UnpackMesh(p%Vars%u, iv, ary, u%PRPMesh) +end subroutine + +subroutine HD_PackOutputValues(p, y, ary) + type(HydroDyn_ParameterType), intent(in) :: p + type(HydroDyn_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + if (y%Morison%Mesh%committed) then + call MV_PackMesh(p%Vars%y, iv, y%Morison%Mesh, ary) + end if + if (y%WAMITMesh%committed) then + call MV_PackMesh(p%Vars%y, iv, y%WAMITMesh, ary) + end if + do while (iv <= size(p%Vars%y)) + call MV_PackVar(p%Vars%y, iv, y%WriteOutput(p%Vars%y(iv)%iUsr(1):p%Vars%y(iv)%iUsr(2)), ary) + end do +end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. @@ -1556,23 +1810,24 @@ end function CalcLoadsAtWRP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. -SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) +SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, IsSolve, dYdu, dXdu, dXddu, dZdu ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(in) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect !! to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with @@ -1581,129 +1836,92 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with !! respect to the inputs (u) [intent in to avoid deallocation] - - - ! local variables - TYPE(HydroDyn_OutputType) :: y_p - TYPE(HydroDyn_OutputType) :: y_m - TYPE(HydroDyn_ContinuousStateType) :: x_p - TYPE(HydroDyn_ContinuousStateType) :: x_m - TYPE(HydroDyn_InputType) :: u_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_plus1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' + TYPE(HydroDyn_OutputType) :: y_p + TYPE(HydroDyn_ContinuousStateType) :: x_p + TYPE(HydroDyn_InputType) :: u_perturb + REAL(R8Ki) :: delta ! delta change in input or state + INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_plus1 + LOGICAL :: IsSolveLoc + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPInput' - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - - n_du_plus1 = size(p%Jac_u_indx,1)+1 - - ! make a copy of the inputs to perturb - call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdu ) ) THEN + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if + + ! Make a copy of the inputs to perturb + call HydroDyn_CopyInput(u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Pack operating point input values for perturbations + call HD_PackInputValues(p, u, m%Vals%u) - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + IF (PRESENT(dYdu)) THEN ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, n_du_plus1, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call HydroDyn_CopyOutput(y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta u - call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta u - call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_u( p, i, -1, u_perturb, delta ) - - ! compute y at u_op - delta u - call HydroDyn_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - - end do - - ! p%WaveElev0 column - dYdu(:,n_du_plus1) = 0 - + ! Loop through input variables + do i = 1, size(p%Vars%u) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle - END IF - + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%Num - IF ( PRESENT( dXdu ) ) THEN + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call HD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call HydroDyn_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, y_p, m%Vals%yp) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call HD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call HydroDyn_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, y_p, m%Vals%yn) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdu(:,k)) + end do + end do + + ! Extended Linearization + dYdu(:,p%Vars%u(size(p%Vars%u))%iLoc(1)) = 0 ! p%WaveElev0 column + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + IF (PRESENT(dXdu)) THEN ! For the case where either RdtnMod=0 and ExtcnMod=0 and hence %SS_Rdtn data or %SS_Exctn data is not valid then we do not have states, so simply return ! The key here is to never allocate the dXdu and related state Jacobian arrays because then the glue-code will behave properly - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%totalStates, n_du_plus1, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if - offsetI = 0 + ! Initialize Jacobian to zero dXdu = 0.0_R8Ki + ! Extended linearization + offsetI = 0 do j = 1,p%nWAMITObj - do i = 1,p%WAMIT(j)%SS_Exctn%numStates - dXdu(offsetI+i,n_du_plus1) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 - end do + dXdu(offsetI+1:offsetI+p%WAMIT(j)%SS_Exctn%numStates,p%Vars%Nu) = p%WAMIT(j)%SS_Exctn%B ! B is numStates by 1 offsetI = offsetI + p%WAMIT(j)%SS_Exctn%numStates end do @@ -1759,7 +1977,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! dXdu(:,startingIndx +11) = p%WAMIT(2)%SS_Rdtn%B(:,5) ! dXdu(:,startingIndx +12) = p%WAMIT(2)%SS_Rdtn%B(:,6) - k=0 offsetI=0 ! First set all translationalVel components @@ -1787,8 +2004,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM END IF - - IF ( PRESENT( dXddu ) ) THEN if (allocated(dXddu)) deallocate(dXddu) END IF @@ -1801,34 +2016,38 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM contains subroutine cleanup() - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) + call HydroDyn_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function END SUBROUTINE HD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, IsSolve, dYdx, dXdx, dXddx, dZdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); !! Output fields are not used by this routine, but type is !! available here so that mesh parameter information (i.e., !! connectivity) does not have to be recalculated for dYdu. - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions (Y) with respect !! to the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) with respect @@ -1839,135 +2058,91 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, !! to the continuous states (x) [intent in to avoid deallocation] ! local variables - TYPE(HydroDyn_OutputType) :: y_p - TYPE(HydroDyn_OutputType) :: y_m - TYPE(HydroDyn_ContinuousStateType) :: x_p - TYPE(HydroDyn_ContinuousStateType) :: x_m - TYPE(HydroDyn_ContinuousStateType) :: x_perturb + TYPE(HydroDyn_OutputType) :: y_p + TYPE(HydroDyn_ContinuousStateType) :: x_p + TYPE(HydroDyn_ContinuousStateType) :: x_perturb REAL(R8Ki) :: delta ! delta change in input or state INTEGER(IntKi) :: i, j, k, sOffset + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HD_JacobianPContState' - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - - - ! make a copy of the continuous states to perturb - call HydroDyn_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if - IF ( PRESENT( dYdx ) ) THEN + ! Pack operating point state values for perturbations + call HD_PackStateValues(p, x, m%Vals%x) - + ! make a copy of the continuous states to perturb + call HydroDyn_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + IF ( PRESENT( dYdx ) ) THEN + ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%totalStates, 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Vars%Ny, p%Vars%Nx, 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call HydroDyn_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call HydroDyn_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do i=1,p%totalStates + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call HydroDyn_CopyOutput(y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - ! get x_op + delta x - call HydroDyn_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_x( p, i, 1, x_perturb, delta ) + ! Loop through state variables + do i = 1,size(p%Vars%x) - ! compute y at x_op + delta x - call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get x_op - delta x - call HydroDyn_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call HD_Perturb_x( p, i, -1, x_perturb, delta ) - - ! compute y at x_op - delta x - call HydroDyn_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) - + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call HD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call HydroDyn_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, y_p, m%Vals%yp) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call HD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call HydroDyn_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call HD_PackOutputValues(p, y_p, m%Vals%yn) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdx(:,k)) + end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF + end if + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! allocate dXdu if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%totalStates, p%totalStates, 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, p%totalStates, p%totalStates, 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return end if + + ! Initialize Jacobian to zero dXdx = 0.0_R8Ki ! Analytical Jacobians from State-space models - if ( p%totalExctnStates > 0 ) then - sOffset = 0 - do k=1,p%nWAMITObj - do j=1,p%WAMIT(k)%SS_Exctn%numStates - do i=1,p%WAMIT(k)%SS_Exctn%numStates ! Loop through all active (enabled) DOFs - dXdx(i+sOffset, j+sOffset) = p%WAMIT(k)%SS_Exctn%A(i,j) - end do - end do - sOffset = sOffset + p%WAMIT(k)%SS_Exctn%numStates - end do - end if - if ( p%totalRdtnStates > 0 ) then - sOffset = 0 - do k=1,p%nWAMITObj - do j=1,p%WAMIT(k)%SS_Rdtn%numStates - do i=1,p%WAMIT(k)%SS_Rdtn%numStates ! Loop through all active (enabled) DOFs - dXdx(i+p%totalExctnStates+sOffset, j+p%totalExctnStates+sOffset) = p%WAMIT(k)%SS_Rdtn%A(i,j) - end do - end do - sOffset = sOffset + p%WAMIT(k)%SS_Rdtn%numStates - end do - end if - - END IF + do i = 1, size(p%Vars%x) + select case (p%Vars%x(i)%jUsr) + case (1) ! SS_Exctn + dXdx(p%Vars%x(i)%iLoc, p%Vars%x(i)%iLoc) = p%WAMIT(p%Vars%x(i)%iUsr(1))%SS_Exctn%A + case (2) ! SS_Rdtn + dXdx(p%Vars%x(i)%iLoc, p%Vars%x(i)%iLoc) = p%WAMIT(p%Vars%x(i)%iUsr(1))%SS_Rdtn%A + end select + end do + end if IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) @@ -1982,12 +2157,14 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, contains subroutine cleanup() call HydroDyn_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function END SUBROUTINE HD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 203c2d8194..e80f30c2b1 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -109,6 +109,7 @@ typedef ^ InitOutputType Morison_Ini typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of HydroDyn" +typedef ^ InitOutputType ModVarsType *Vars - - - "Module Variables" - typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ ^ CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - @@ -146,7 +147,8 @@ typedef ^ ^ Morison_Oth # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - +typedef ^ MiscVarType ModValsType Vals - - - "Module Values" - +typedef ^ ^ MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - @@ -162,7 +164,8 @@ typedef ^ ^ WAMIT_Input # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - +typedef ^ ParameterType ModVarsType &Vars - - - "Module Variables" - +typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - typedef ^ ^ INTEGER vecMultiplier - - - "multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1" - typedef ^ ^ WAMIT_ParameterType WAMIT {:} - - "Parameter data for the WAMIT module" - typedef ^ ^ WAMIT2_ParameterType WAMIT2 {:} - - "Parameter data for the WAMIT2 module" - diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index e70472aac7..6f21afd8c2 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -125,6 +125,7 @@ MODULE HydroDyn_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 HydroDyn [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -165,6 +166,7 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_MiscVarType ======= TYPE, PUBLIC :: HydroDyn_MiscVarType + TYPE(ModValsType) :: Vals !< Module Values [-] 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 = 0_IntKi !< The output decimation counter [-] @@ -181,6 +183,7 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module Variables [-] 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 [-] @@ -1192,6 +1195,7 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y) UB(1:1) = ubound(SrcInitOutputData%LinNames_y) @@ -1273,6 +1277,7 @@ subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1294,6 +1299,7 @@ subroutine HydroDyn_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call Morison_PackInitOutput(Buf, InData%Morison) call RegPack(Buf, allocated(InData%WriteOutputHdr)) @@ -1307,6 +1313,13 @@ subroutine HydroDyn_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) @@ -1342,6 +1355,8 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call Morison_UnpackInitOutput(Buf, OutData%Morison) ! Morison if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) @@ -1373,6 +1388,26 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1886,6 +1921,9 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1984,6 +2022,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) @@ -2032,6 +2072,7 @@ subroutine HydroDyn_PackMisc(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModValsType(Buf, InData%Vals) call MeshPack(Buf, InData%AllHdroOrigin) call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) call RegPack(Buf, InData%Decimate) @@ -2088,6 +2129,7 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals call MeshUnpack(Buf, OutData%AllHdroOrigin) ! AllHdroOrigin call HydroDyn_UnpackHD_ModuleMapType(Buf, OutData%HD_MeshMap) ! HD_MeshMap call RegUnpack(Buf, OutData%Decimate) @@ -2187,6 +2229,18 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if DstParamData%nWAMITObj = SrcParamData%nWAMITObj DstParamData%vecMultiplier = SrcParamData%vecMultiplier if (allocated(SrcParamData%WAMIT)) then @@ -2358,6 +2412,12 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if if (allocated(ParamData%WAMIT)) then LB(1:1) = lbound(ParamData%WAMIT) UB(1:1) = ubound(ParamData%WAMIT) @@ -2419,6 +2479,13 @@ subroutine HydroDyn_PackParam(Buf, Indata) integer(IntKi) :: LB(3), UB(3) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, InData%nWAMITObj) call RegPack(Buf, InData%vecMultiplier) call RegPack(Buf, allocated(InData%WAMIT)) @@ -2526,6 +2593,26 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(Buf, OutData%nWAMITObj) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%vecMultiplier) diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 4146c1c083..7a6702c251 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1536,6 +1536,7 @@ subroutine MeshPack (Buf, Mesh) call RegPack(Buf, Mesh%ios) call RegPack(Buf, Mesh%nnodes) call RegPack(Buf, Mesh%refnode) + call RegPack(Buf, Mesh%ID) call RegPack(Buf, Mesh%nextelem) call RegPack(Buf, Mesh%nscalars) @@ -1595,7 +1596,7 @@ SUBROUTINE MeshUnpack(Buf, Mesh) ! the existing sibling as an optional argument so that the sibling relationship is also recreated. LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) - INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode + INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode, id INTEGER i,j integer(IntKi) :: EN(20) ! Element nodes @@ -1622,6 +1623,7 @@ SUBROUTINE MeshUnpack(Buf, Mesh) call RegUnpack(Buf, ios) call RegUnpack(Buf, nnodes) call RegUnpack(Buf, refnode) + call RegUnpack(Buf, id) call RegUnpack(Buf, nextelem) call RegUnpack(Buf, nscalars) @@ -1644,6 +1646,7 @@ SUBROUTINE MeshUnpack(Buf, Mesh) if (Buf%ErrStat >= AbortErrLev) return Mesh%RefNode = refnode + Mesh%ID = id Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem @@ -1973,7 +1976,8 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%Initialized = SrcMesh%Initialized DestMesh%Committed = SrcMesh%Committed - DestMesh%refNode = SrcMesh%refNode + DestMesh%refNode = SrcMesh%refNode + DestMesh%ID = SrcMesh%ID IF ( ALLOCATED(SrcMesh%Force ) .AND. ALLOCATED(DestMesh%Force ) ) DestMesh%Force = SrcMesh%Force IF ( ALLOCATED(SrcMesh%Moment ) .AND. ALLOCATED(DestMesh%Moment ) ) DestMesh%Moment = SrcMesh%Moment IF ( ALLOCATED(SrcMesh%Orientation ) .AND. ALLOCATED(DestMesh%Orientation ) ) DestMesh%Orientation = SrcMesh%Orientation diff --git a/modules/nwtc-library/src/ModMesh_Types.f90 b/modules/nwtc-library/src/ModMesh_Types.f90 index 1bca2c98a9..b50ab5d997 100644 --- a/modules/nwtc-library/src/ModMesh_Types.f90 +++ b/modules/nwtc-library/src/ModMesh_Types.f90 @@ -107,6 +107,7 @@ MODULE ModMesh_Types INTEGER :: ios !< Mesh type: input (1), output(2), or state(3) INTEGER :: refNode = 0 !< optional reference node (informational only) INTEGER :: Nnodes = 0 !< Number of nodes (vertices) in mesh + INTEGER :: ID = 0 !< Mesh identifier (used during init) ! Mesh elements TYPE(ElemTabType), POINTER :: ElemTable(:) => NULL() !< A table of all elements in the mesh, by type diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 index 3dac37cc90..f6c7db7fc0 100644 --- a/modules/nwtc-library/src/ModVar.f90 +++ b/modules/nwtc-library/src/ModVar.f90 @@ -343,10 +343,9 @@ subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) integer(IntKi), intent(inout) :: iVar type(MeshType), intent(in) :: Mesh real(R8Ki), intent(inout) :: Values(:) - character(VarNameLen) :: MeshName - integer(IntKi) :: j - MeshName = VarAry(iVar)%Name - do while (VarAry(iVar)%Name == MeshName) + integer(IntKi) :: MeshID, j + MeshID = VarAry(iVar)%MeshID + do while (VarAry(iVar)%MeshID == MeshID) select case (VarAry(iVar)%Field) case (VF_Force) Values(VarAry(iVar)%iLoc) = pack(Mesh%Force, .true.) @@ -379,10 +378,9 @@ subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) integer(IntKi), intent(inout) :: iVar real(R8Ki), intent(in) :: Values(:) type(MeshType), intent(inout) :: Mesh - character(VarNameLen) :: MeshName - integer(IntKi) :: j - MeshName = VarAry(iVar)%Name - do while (VarAry(iVar)%Name == MeshName) + integer(IntKi) :: MeshID, j + MeshID = VarAry(iVar)%MeshID + do while (VarAry(iVar)%MeshID == MeshID) select case (VarAry(iVar)%Field) case (VF_Force) Mesh%Force = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Force)) @@ -571,36 +569,41 @@ subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, end subroutine -subroutine MV_AddMeshVar(VarAry, Name, Fields, Nodes, Flags, Perturbs, Active) +subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Fields(:) - integer(IntKi), intent(in) :: Nodes integer(IntKi), optional, intent(in) :: Flags + type(MeshType), intent(inout) :: Mesh real(R8Ki), optional, intent(in) :: Perturbs(:) - logical, optional, intent(in) :: Active integer(IntKi) :: i, FlagsLocal logical :: ActiveLocal real(R8Ki), allocatable :: PerturbsLocal(:) + if (.not. Mesh%committed) return + if (allocated(VarAry)) then + Mesh%ID = size(VarAry) + 1 + else + Mesh%ID = 1 + end if FlagsLocal = 0 if (present(Flags)) FlagsLocal = Flags FlagsLocal = ior(FlagsLocal, VF_Mesh) PerturbsLocal = [(0.0_R8Ki, i=1, size(Fields))] if (present(Perturbs)) PerturbsLocal = Perturbs - ActiveLocal = .true. - if (present(Active)) ActiveLocal = Active do i = 1, size(Fields) - call MV_AddVar(VarAry, Name, Fields(i), Num=Nodes, Flags=FlagsLocal, & - Perturb=PerturbsLocal(i), Active=ActiveLocal) + call MV_AddVar(VarAry, Name, Fields(i), Num=Mesh%Nnodes, Flags=FlagsLocal, & + Perturb=PerturbsLocal(i)) + VarAry(size(VarAry))%MeshID = Mesh%ID end do end subroutine -subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, Perturb, LinNames, Active) +subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, Active) type(ModVarType), allocatable, intent(inout) :: VarAry(:) character(*), intent(in) :: Name integer(IntKi), intent(in) :: Field integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr real(R8Ki), optional, intent(in) :: Perturb + integer(IntKi), optional, intent(in) :: DerivOrder logical, optional, intent(in) :: Active character(*), optional, intent(in) :: LinNames(:) integer(IntKi) :: i @@ -628,16 +631,20 @@ subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, Perturb, LinNa end if ! Set Derivative Order - select case (Var%Field) - case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position/displacement - Var%DerivOrder = 0 - case (VF_TransVel, VF_AngularVel) ! Velocity - Var%DerivOrder = 1 - case (VF_TransAcc, VF_AngularAcc) ! Acceleration - Var%DerivOrder = 2 - case default - Var%DerivOrder = -1 - end select + if (present(DerivOrder)) then + Var%DerivOrder = DerivOrder + else + select case (Var%Field) + case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position/displacement + Var%DerivOrder = 0 + case (VF_TransVel, VF_AngularVel) ! Velocity + Var%DerivOrder = 1 + case (VF_TransAcc, VF_AngularAcc) ! Acceleration + Var%DerivOrder = 2 + case default + Var%DerivOrder = -1 + end select + end if ! Append Var to VarArray if (allocated(VarAry)) then diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index c20e288196..51936f4bbf 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -120,8 +120,9 @@ MODULE NWTC_Library_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] - REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation [-] character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] END TYPE ModVarType ! ======================= @@ -814,8 +815,9 @@ subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, Ctr end if DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr - DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID DstModVarTypeData%Solve = SrcModVarTypeData%Solve + DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb if (allocated(SrcModVarTypeData%LinNames)) then LB(1:1) = lbound(SrcModVarTypeData%LinNames) UB(1:1) = ubound(SrcModVarTypeData%LinNames) @@ -887,8 +889,9 @@ subroutine NWTC_Library_PackModVarType(Buf, Indata) end if call RegPack(Buf, InData%iUsr) call RegPack(Buf, InData%jUsr) - call RegPack(Buf, InData%Perturb) + call RegPack(Buf, InData%MeshID) call RegPack(Buf, InData%Solve) + call RegPack(Buf, InData%Perturb) call RegPack(Buf, allocated(InData%LinNames)) if (allocated(InData%LinNames)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames), ubound(InData%LinNames)) @@ -977,10 +980,12 @@ subroutine NWTC_Library_UnPackModVarType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%jUsr) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Perturb) + call RegUnpack(Buf, OutData%MeshID) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Solve) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Perturb) + if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%LinNames)) deallocate(OutData%LinNames) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 468145b22b..bcdb598af3 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -75,8 +75,9 @@ typedef ^ ^ IntKi iLin : - - typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - -typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi ModNum - 0 - "" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 9eb4eabf08..0cf5a2a9db 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -75,8 +75,9 @@ typedef ^ ^ IntKi iLin : - - typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - -typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - typedef ^ ^ character(LinChanLen) LinNames : - - "" - typedef ^ ModVarsType IntKi ModNum - 0 - "" - diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index c795d9d1b8..c9a1ae842d 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -411,9 +411,9 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, x_TC, q_TC, T, ErrS u_SD => T%SD%Input(1), x_SD => T%SD%x(STATE_PRED)) ! Transfer tight coupling states to module - ! call SD_PackStateValues(p_SD, x_SD, m_SD%Vals%x) - ! call XferGblToLoc1D(ModData%ixs, x_TC, m_SD%Vals%x) - ! call SD_UnpackStateValues(p_SD, m_SD%Vals%x, x_SD) + call SD_PackStateValues(p_SD, x_SD, m_SD%Vals%x) + call XferGblToLoc1D(ModData%ixs, x_TC, m_SD%Vals%x) + call SD_UnpackStateValues(p_SD, m_SD%Vals%x, x_SD) end associate @@ -478,162 +478,274 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) ! Switch by destination module select case (ModDst%ID) - case (Module_AD) !-------------------------------------------------- +!------------------------------------------------------------------------------- +! Module_AD Inputs +!------------------------------------------------------------------------------- + case (Module_AD) select case (ModSrc%ID) case (Module_ED) - call MapMotionMesh(Key='ED TowerMotion -> AD TowerMotion', & - SrcMod=ModSrc, SrcMeshName='TowerMotion', & - DstMod=ModDst, DstMeshName='R1TowerMotion', & + call MotionMeshMap(Maps, Key='ED TowerMotion -> AD TowerMotion', & + SrcMod=ModSrc, SrcMesh=T%ED%y%TowerLn2Mesh, & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%TowerMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=T%AD%Input(1)%rotors(1)%TowerMotion%Committed) - - call MapMotionMesh(Key='ED HubMotion -> AD HubMotion', & - SrcMod=ModSrc, SrcMeshName='HubMotion', & - DstMod=ModDst, DstMeshName='R1HubMotion') - - call MapMotionMesh(Key='ED NacelleMotion -> AD NacelleMotion', & - SrcMod=ModSrc, SrcMeshName='NacelleMotion', & - DstMod=ModDst, DstMeshName='R1NacelleMotion', & + if (Failed()) return + + call MotionMeshMap(Maps, Key='ED HubMotion -> AD HubMotion', & + SrcMod=ModSrc, SrcMesh=T%ED%y%HubPtMotion, & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%HubMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call MotionMeshMap(Maps, Key='ED NacelleMotion -> AD NacelleMotion', & + SrcMod=ModSrc, SrcMesh=T%ED%y%NacelleMotion, & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%NacelleMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=T%AD%Input(1)%rotors(1)%NacelleMotion%Committed) + if (Failed()) return - call MapMotionMesh(Key='ED TFinMotion -> AD TFinMotion', & - SrcMod=ModSrc, SrcMeshName='TFinMotion', & - DstMod=ModDst, DstMeshName='R1TFinMotion', & + call MotionMeshMap(Maps, Key='ED TFinMotion -> AD TFinMotion', & + SrcMod=ModSrc, SrcMesh=T%ED%y%TFinCMMotion, & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%TFinMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=T%AD%Input(1)%rotors(1)%TFinMotion%Committed) + if (Failed()) return do i = 1, size(T%ED%y%BladeRootMotion) - call MapMotionMesh(Key='ED BladeRootMotion -> AD BladeRootMotion', i1=i, & - SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//IdxStr(i), & - DstMod=ModDst, DstMeshName='R1BladeRootMotion'//IdxStr(i)) + call MotionMeshMap(Maps, Key='ED BladeRootMotion -> AD BladeRootMotion', i1=i, & + SrcMod=ModSrc, SrcMesh=T%ED%y%BladeRootMotion(i), & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%BladeRootMotion(i), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do if (T%p_FAST%CompElast == Module_ED) then do i = 1, size(T%ED%y%BladeLn2Mesh) - call MapMotionMesh(Key='ED BladeMotion -> AD BladeMotion', i1=i, & - SrcMod=ModSrc, SrcMeshName='BladeMotion'//IdxStr(i), & - DstMod=ModDst, DstMeshName='R1BladeMotion'//IdxStr(i)) + call MotionMeshMap(Maps, Key='ED BladeMotion -> AD BladeMotion', i1=i, & + SrcMod=ModSrc, SrcMesh=T%ED%y%BladeLn2Mesh(i), & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%BladeMotion(i), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do end if case (Module_BD) - call MapMotionMesh(Key='BD BladeMotion -> AD BladeMotion', & - SrcMod=ModSrc, SrcMeshName='BladeMotion', & - DstMod=ModDst, DstMeshName='R1BladeMotion'//IdxStr(ModSrc%Ins)) + call MotionMeshMap(Maps, Key='BD BladeMotion -> AD BladeMotion', & + SrcMod=ModSrc, SrcMesh=T%BD%y(ModSrc%Ins)%BldMotion, & + DstMod=ModDst, DstMesh=T%AD%Input(1)%rotors(1)%BladeMotion(ModSrc%Ins), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SrvD) - call MapNonMesh(Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=ModSrc, DstMod=ModDst) end select - case (Module_BD) !-------------------------------------------------- +!------------------------------------------------------------------------------- +! Module_BD Inputs +!------------------------------------------------------------------------------- + case (Module_BD) select case (ModSrc%ID) case (Module_ED) - call MapMotionMesh(Key='ED BladeRoot -> BD RootMotion', & - SrcMod=ModSrc, SrcMeshName='BladeRootMotion'//IdxStr(ModDst%Ins), & - DstMod=ModDst, DstMeshName='RootMotion') + call MotionMeshMap(Maps, Key='ED BladeRoot -> BD RootMotion', & + SrcMod=ModSrc, SrcMesh=T%ED%y%BladeRootMotion(ModDst%Ins), & + DstMod=ModDst, DstMesh=T%BD%Input(1, ModDst%Ins)%RootMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_AD) - call MapLoadMesh(Key='AD BladeLoad -> BD DistrLoad', & - SrcMod=ModSrc, SrcMeshName='R1BladeLoad'//IdxStr(ModDst%Ins), SrcDispMeshName='R1BladeMotion'//IdxStr(ModDst%Ins), & - DstMod=ModDst, DstMeshName='DistrLoad', DstDispMeshName='BladeMotion') + call LoadMeshMap(Maps, Key='AD BladeLoad -> BD DistrLoad', & + SrcMod=ModSrc, SrcMesh=T%AD%y%rotors(1)%BladeLoad(ModDst%Ins), & + SrcDispMesh=T%AD%Input(1)%rotors(1)%BladeMotion(ModDst%Ins), & + DstMod=ModDst, DstMesh=T%BD%Input(1, ModDst%Ins)%DistrLoad, & + DstDispMesh=T%BD%y(ModDst%Ins)%BldMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SrvD) - ! if (allocated(T%SrvD%y%BStCLoadMesh)) then - ! do j = 1, size(T%SrvD%y%BStCLoadMesh, 2) - ! call MapLoadMesh(Key='SrvD BStCLoadMesh -> BD DistrLoad', i1=j, & - ! SrcMod=ModSrc, & - ! SrcMeshName='BStCLoadMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & - ! SrcDispMeshName='BStCMotionMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & - ! DstMod=ModDst, DstMeshName='DistrLoad', DstDispMeshName='BladeMotion', & - ! Active=T%SrvD%y%BStCLoadMesh(ModDst%Ins, j)%Committed) - ! end do - ! end if - end select - case (Module_ED) !-------------------------------------------------- +!------------------------------------------------------------------------------- +! Module_ED Inputs +!------------------------------------------------------------------------------- + case (Module_ED) select case (ModSrc%ID) case (Module_BD) - call MapLoadMesh(Key='BD ReactionForce -> ED HubLoad', & - SrcMod=ModSrc, SrcMeshName='ReactionForce', SrcDispMeshName='RootMotion', & - DstMod=ModDst, DstMeshName='HubLoad', DstDispMeshName='HubMotion') + call LoadMeshMap(Maps, Key='BD ReactionForce -> ED HubLoad', & + SrcMod=ModSrc, SrcMesh=T%BD%y(ModSrc%Ins)%ReactionForce, & + SrcDispMesh=T%BD%Input(1, ModSrc%Ins)%RootMotion, & + DstMod=ModDst, DstMesh=T%ED%Input(1)%HubPtLoad, & + DstDispMesh=T%ED%y%HubPtMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_AD) if (T%p_FAST%CompElast == Module_ED) then do i = 1, size(T%ED%Input(1)%BladePtLoads) - call MapLoadMesh(Key='AD BladeLoad -> ED BladeLoad', i1=i, & - SrcMod=ModSrc, SrcMeshName='R1BladeLoad'//IdxStr(i), SrcDispMeshName='R1BladeMotion'//IdxStr(i), & - DstMod=ModDst, DstMeshName='BladeLoad'//IdxStr(i), DstDispMeshName='BladeMotion'//IdxStr(i)) + call LoadMeshMap(Maps, Key='AD BladeLoad -> ED BladeLoad', i1=i, & + SrcMod=ModSrc, SrcMesh=T%AD%y%rotors(1)%BladeLoad(i), & + SrcDispMesh=T%AD%Input(1)%rotors(1)%BladeMotion(i), & + DstMod=ModDst, DstMesh=T%ED%Input(1)%BladePtLoads(i), & + DstDispMesh=T%ED%y%BladeLn2Mesh(i), & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return end do end if - call MapLoadMesh(Key='AD TowerLoad -> ED TowerLoad', & - SrcMod=ModSrc, SrcMeshName='R1TowerLoad', SrcDispMeshName='R1TowerMotion', & - DstMod=ModDst, DstMeshName='TowerLoad', DstDispMeshName='TowerMotion', & + call LoadMeshMap(Maps, Key='AD TowerLoad -> ED TowerLoad', & + SrcMod=ModSrc, SrcMesh=T%AD%y%rotors(1)%TowerLoad, & + SrcDispMesh=T%AD%y%rotors(1)%TowerLoad, & + DstMod=ModDst, DstMesh=T%ED%Input(1)%TowerPtLoads, & + DstDispMesh=T%ED%y%TowerLn2Mesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=T%AD%y%rotors(1)%TowerLoad%committed) - - call MapLoadMesh(Key='AD NacelleLoad -> ED NacelleLoad', & - SrcMod=ModSrc, SrcMeshName='R1NacelleLoad', SrcDispMeshName='R1NacelleMotion', & - DstMod=ModDst, DstMeshName='NacelleLoad', DstDispMeshName='NacelleMotion', & + if (Failed()) return + + call LoadMeshMap(Maps, Key='AD NacelleLoad -> ED NacelleLoad', & + SrcMod=ModSrc, SrcMesh=T%AD%y%rotors(1)%NacelleLoad, & + SrcDispMesh=T%AD%Input(1)%rotors(1)%NacelleMotion, & + DstMod=ModDst, DstMesh=T%ED%Input(1)%NacelleLoads, & + DstDispMesh=T%ED%y%NacelleMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & Active=T%AD%Input(1)%rotors(1)%NacelleMotion%committed) + if (Failed()) return + + call LoadMeshMap(Maps, Key='AD HubLoad -> ED HubLoad', & + SrcMod=ModSrc, SrcMesh=T%AD%y%rotors(1)%HubLoad, & + SrcDispMesh=T%AD%Input(1)%rotors(1)%HubMotion, & + DstMod=ModDst, DstMesh=T%ED%Input(1)%HubPtLoad, & + DstDispMesh=T%ED%y%HubPtMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + call LoadMeshMap(Maps, Key='AD TFinLoad -> ED TFinLoad', & + SrcMod=ModSrc, SrcMesh=T%AD%y%rotors(1)%TFinLoad, & + SrcDispMesh=T%AD%Input(1)%rotors(1)%TFinMotion, & + DstMod=ModDst, DstMesh=T%ED%Input(1)%TFinCMLoads, & + DstDispMesh=T%ED%y%TFinCMMotion, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=T%AD%Input(1)%rotors(1)%TFinMotion%committed) + if (Failed()) return - ! call MapLoadMesh(Key='AD HubLoad -> ED HubLoad', & - ! SrcMod=ModSrc, SrcMeshName='R1HubLoad', SrcDispMeshName='R1HubMotion', & - ! DstMod=ModDst, DstMeshName='HubLoad', DstDispMeshName='HubMotion', & - ! Active=T%AD%Input(1)%rotors(1)%HubMotion%committed) + case (Module_SD) - call MapLoadMesh(Key='AD TFinLoad -> ED TFinLoad', & - SrcMod=ModSrc, SrcMeshName='R1TFinLoad', SrcDispMeshName='R1TFinMotion', & - DstMod=ModDst, DstMeshName='TFinLoad', DstDispMeshName='TFinMotion', & - Active=T%AD%Input(1)%rotors(1)%TFinMotion%committed) + call LoadMeshMap(Maps, Key='SD Y1Mesh -> ED Platform', & + SrcMod=ModSrc, SrcMesh=T%SD%y%Y1mesh, & + SrcDispMesh=T%SD%Input(1)%TPMesh, & + DstMod=ModDst, DstMesh=T%ED%Input(1)%PlatformPtMesh, & + DstDispMesh=T%ED%y%PlatformPtMesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return case (Module_SrvD) - call MapNonMesh("SrvD Data -> ED Data", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "SrvD Data -> ED Data", SrcMod=ModSrc, DstMod=ModDst) + + end select + +!------------------------------------------------------------------------------- +! Module_HD Inputs +!------------------------------------------------------------------------------- + case (Module_HD) + + select case (ModSrc%ID) + case (Module_ED) + + call MotionMeshMap(Maps, Key='ED PlatformMotion -> HD PRPMesh', & + SrcMod=ModSrc, SrcMesh=T%ED%y%PlatformPtMesh, & + DstMod=ModDst, DstMesh=T%HD%Input(1)%PRPMesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! If SubDyn is not active substructure motion/loads come from ElastoDyn + if (T%p_FAST%CompSub /= Module_SD) then + + call MotionMeshMap(Maps, Key='ED PlatformMotion -> HD WAMIT', & + SrcMod=ModSrc, SrcMesh=T%ED%y%PlatformPtMesh, & + DstMod=ModDst, DstMesh=T%HD%Input(1)%WAMITMesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=T%HD%y%WAMITMesh%Committed) + if (Failed()) return + + call MotionMeshMap(Maps, Key='ED PlatformMotion -> HD Morison', & + SrcMod=ModSrc, SrcMesh=T%ED%y%PlatformPtMesh, & + DstMod=ModDst, DstMesh=T%HD%Input(1)%Morison%Mesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=T%HD%Input(1)%Morison%Mesh%Committed) + if (Failed()) return + end if - ! if ((T%p_FAST%CompElast == Module_ED) .and. allocated(T%SrvD%y%BStCLoadMesh)) then - ! do j = 1, size(T%SrvD%y%BStCLoadMesh, 2) - ! call MapLoadMesh(Key='SrvD BStCLoadMesh -> ED BladeLoad', i1=j, & - ! SrcMod=ModSrc, & - ! SrcMeshName='BStCLoadMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & - ! SrcDispMeshName='BStCMotionMesh('//trim(Num2LStr(ModDst%Ins))//','//trim(Num2LStr(j))//')', & - ! DstMod=ModDst, DstMeshName='BladeLoad'//Num2LStr(i), DstDispMeshName='BladeMotion', & - ! Active=T%SrvD%y%BStCLoadMesh(ModDst%Ins, j)%Committed) - ! end do - ! end if + case (Module_SD) + call MotionMeshMap(Maps, Key='SD Y2Mesh -> HD WAMIT', & + SrcMod=ModSrc, SrcMesh=T%SD%y%Y2Mesh, & + DstMod=ModDst, DstMesh=T%HD%Input(1)%WAMITMesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=T%HD%y%WAMITMesh%Committed) + if (Failed()) return + + call MotionMeshMap(Maps, Key='SD Y2Mesh -> HD Morison', & + SrcMod=ModSrc, SrcMesh=T%SD%y%Y2Mesh, & + DstMod=ModDst, DstMesh=T%HD%Input(1)%Morison%Mesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2, & + Active=T%HD%Input(1)%Morison%Mesh%Committed) + if (Failed()) return end select - case (Module_IfW) !------------------------------------------------- +!------------------------------------------------------------------------------- +! Module_IfW Inputs +!------------------------------------------------------------------------------- + case (Module_IfW) select case (ModSrc%ID) case (Module_ED) - call MapNonMesh("ED HubMotion -> IfW HubMotion", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "ED HubMotion -> IfW HubMotion", SrcMod=ModSrc, DstMod=ModDst) end select - case (Module_SrvD) !------------------------------------------------ +!------------------------------------------------------------------------------- +! Module_SD Inputs +!------------------------------------------------------------------------------- + case (Module_SD) + + select case (ModSrc%ID) + + case (Module_ED) + call MotionMeshMap(Maps, Key='ED PlatformMotion -> SD TPMesh', & + SrcMod=ModSrc, SrcMesh=T%ED%y%PlatformPtMesh, & + DstMod=ModDst, DstMesh=T%SD%Input(1)%TPMesh, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + end select + +!------------------------------------------------------------------------------- +! Module_SrvD Inputs +!------------------------------------------------------------------------------- + + case (Module_SrvD) select case (ModSrc%ID) case (Module_BD) - call MapNonMesh("BD Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) - call MapNonMesh("BD RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "BD Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "BD RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) case (Module_ED) - call MapNonMesh("ED Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "ED Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) if (T%p_FAST%CompElast == Module_ED) then - call MapNonMesh("ED RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "ED RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) end if case (Module_IfW) - call MapNonMesh("IfW Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) + call NonMeshMap(Maps, "IfW Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) end select end select @@ -664,25 +776,30 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) select case (Map%Typ) case (Map_LoadMesh) - ! Source mesh variable indices - Map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, Map%SrcMeshName, LoadFields(i)), i=1, size(LoadFields))] - Map%SrcVarIdx = pack(Map%SrcVarIdx, Map%SrcVarIdx > 0) - - ! Destination mesh variable indices - Map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, Map%DstMeshName, LoadFields(i)), i=1, size(LoadFields))] - Map%DstVarIdx = pack(Map%DstVarIdx, Map%DstVarIdx > 0) + ! Source and destination mesh variable indices + Map%SrcVarIdx = pack([(i, i=1, size(SrcMod%Vars%y))], SrcMod%Vars%y%MeshID == Map%SrcMeshID) + Map%DstVarIdx = pack([(i, i=1, size(DstMod%Vars%u))], DstMod%Vars%u%MeshID == Map%DstMeshID) ! Source displacement mesh is in input of source module (only translation displacement needed) - Map%SrcDispVarIdx = MV_VarIndex(SrcMod%Vars%u, Map%SrcDispMeshName, VF_TransDisp) + do i = 1, size(SrcMod%Vars%u) + if (SrcMod%Vars%u(i)%MeshID == Map%SrcDispMeshID .and. SrcMod%Vars%u(i)%Field == VF_TransDisp) Map%SrcDispVarIdx = i + end do ! Destination displacement mesh is in output of destination module (only translation displacement needed) - Map%DstDispVarIdx = MV_VarIndex(DstMod%Vars%y, Map%DstDispMeshName, VF_TransDisp) + do i = 1, size(DstMod%Vars%y) + if (DstMod%Vars%y(i)%MeshID == Map%DstDispMeshID .and. DstMod%Vars%y(i)%Field == VF_TransDisp) Map%DstDispVarIdx = i + end do ! If source or destination meshes not found, return error - if (size(Map%SrcVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No load fields found for src mesh '//Map%SrcMeshName, ErrStat, ErrMsg, RoutineName) - if (size(Map%DstVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No load fields found for dst mesh '//Map%DstMeshName, ErrStat, ErrMsg, RoutineName) - if (Map%SrcDispVarIdx == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No TransDisp field found for src mesh '//Map%SrcDispMeshName, ErrStat, ErrMsg, RoutineName) - if (Map%DstDispVarIdx == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No TransDisp field found for dst mesh '//Map%DstDispMeshName, ErrStat, ErrMsg, RoutineName) + if (size(Map%SrcVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No vars match src mesh', ErrStat, ErrMsg, RoutineName) + else if (size(Map%DstVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No vars match dst mesh', ErrStat, ErrMsg, RoutineName) + else if (Map%SrcDispVarIdx == 0) then + call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No vars match src disp mesh', ErrStat, ErrMsg, RoutineName) + else if (Map%DstDispVarIdx == 0) then + call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No vars match dst disp mesh', ErrStat, ErrMsg, RoutineName) + end if if (ErrStat >= AbortErrLev) return ! Set Variable solve flag to true @@ -695,17 +812,16 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) case (Map_MotionMesh) - ! Source mesh motion field variables - map%SrcVarIdx = [(MV_VarIndex(SrcMod%Vars%y, map%SrcMeshName, MotionFields(i)), i=1, size(MotionFields))] - map%SrcVarIdx = pack(map%SrcVarIdx, map%SrcVarIdx > 0) - - ! Destination mesh motion field variables - map%DstVarIdx = [(MV_VarIndex(DstMod%Vars%u, map%DstMeshName, MotionFields(i)), i=1, size(MotionFields))] - map%DstVarIdx = pack(map%DstVarIdx, map%DstVarIdx > 0) + ! Source and destination mesh variable indices + Map%SrcVarIdx = pack([(i, i=1, size(SrcMod%Vars%y))], SrcMod%Vars%y%MeshID == Map%SrcMeshID) + Map%DstVarIdx = pack([(i, i=1, size(DstMod%Vars%u))], DstMod%Vars%u%MeshID == Map%DstMeshID) ! If source or destination meshes not found, return error - if (size(Map%SrcVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No motion fields found for src mesh '//Map%SrcMeshName, ErrStat, ErrMsg, RoutineName) - if (size(Map%DstVarIdx) == 0) call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No motion fields found for dst mesh '//Map%DstMeshName, ErrStat, ErrMsg, RoutineName) + if (size(Map%SrcVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No vars match src mesh', ErrStat, ErrMsg, RoutineName) + else if (size(Map%DstVarIdx) == 0) then + call SetErrStat(ErrID_Fatal, 'Mapping "'//trim(Map%Key)//'": No vars match dst mesh', ErrStat, ErrMsg, RoutineName) + end if if (ErrStat >= AbortErrLev) return ! Set Variable solve flag to true @@ -721,186 +837,157 @@ subroutine FAST_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) end select end associate - end do - !---------------------------------------------------------------------------- - ! Initialize Mapping meshes - !---------------------------------------------------------------------------- - - ! Loop through mappings - do i = 1, size(Maps) - - ! Select by mapping key - select case (Maps(i)%Key) - - !---------------------------------------------------------------------- - ! AeroDyn Inputs - !---------------------------------------------------------------------- - - case ('BD BladeMotion -> AD BladeMotion') - call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%BldMotion, T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%DstIns), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('ED BladeMotion -> AD BladeMotion') - call MeshMapCreate(T%ED%y%BladeLn2Mesh(Maps(i)%i1), T%AD%Input(1)%rotors(1)%BladeMotion(Maps(i)%i1), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('ED BladeRootMotion -> AD BladeRootMotion') - call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%i1), T%AD%Input(1)%rotors(1)%BladeRootMotion(Maps(i)%i1), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('ED HubMotion -> AD HubMotion') - call MeshMapCreate(T%ED%y%HubPtMotion, T%AD%Input(1)%rotors(1)%HubMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('ED NacelleMotion -> AD NacelleMotion') - call MeshMapCreate(T%ED%y%NacelleMotion, T%AD%Input(1)%rotors(1)%NacelleMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('ED TFinMotion -> AD TFinMotion') - call MeshMapCreate(T%ED%y%TFinCMMotion, T%AD%Input(1)%rotors(1)%TFinMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('ED TowerMotion -> AD TowerMotion') - call MeshMapCreate(T%ED%y%TowerLn2Mesh, T%AD%Input(1)%rotors(1)%TowerMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - - case ('SrvD BlAirfoilCom -> AD UserProp') +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - !---------------------------------------------------------------------- - ! BeamDyn Inputs - !---------------------------------------------------------------------- +subroutine LoadMeshMap(Mappings, Key, SrcMod, SrcMesh, SrcDispMesh, & + DstMod, DstMesh, DstDispMesh, ErrStat, ErrMsg, i1, i2, Active) + type(TC_MappingType), allocatable :: Mappings(:) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + type(MeshType), intent(in) :: SrcMesh + type(MeshType), intent(inout) :: DstMesh ! intent(inout) for copy + type(MeshType), intent(in) :: SrcDispMesh, DstDispMesh + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi), optional, intent(in) :: i1, i2 + logical, optional, intent(in) :: Active - case ('AD BladeLoad -> BD DistrLoad') - call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + character(*), parameter :: RoutineName = 'MotionMeshMap' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i1Loc, i2Loc + type(TC_MappingType) :: Mapping - case ('ED BladeRoot -> BD RootMotion') - call MeshMapCreate(T%ED%y%BladeRootMotion(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%RootMotion, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + ErrStat = ErrID_None + ErrMsg = '' - case ('SrvD BStCLoadMesh -> BD DistrLoad') - call MeshMapCreate(T%SrvD%y%BStCLoadMesh(Maps(i)%DstIns, Maps(i)%i1), T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%BD%Input(1, Maps(i)%DstIns)%DistrLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if - !---------------------------------------------------------------------- - ! ElastoDyn Inputs - !---------------------------------------------------------------------- + ! Check that all meshes in mapping have nonzero identifiers + if (SrcMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (SrcDispMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcDispMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (DstMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (DstDispMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstDispMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + end if - case ('AD BladeLoad -> ED BladeLoad') - call MeshMapCreate(T%AD%y%rotors(1)%BladeLoad(Maps(i)%i1), T%ED%Input(1)%BladePtLoads(Maps(i)%i1), Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%ED%Input(1)%BladePtLoads(Maps(i)%i1), Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + ! Get optional mapping indicies + i1Loc = 0; if (present(i1)) i1Loc = i1 + i2Loc = 0; if (present(i2)) i2Loc = i2 - case ('AD NacelleLoad -> ED NacelleLoad') - call MeshMapCreate(T%AD%y%rotors(1)%NacelleLoad, T%ED%Input(1)%NacelleLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%ED%Input(1)%NacelleLoads, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + ! Initialize mapping structure + Mapping = TC_MappingType(Key=Key, Typ=Map_LoadMesh, i1=i1Loc, i2=i2Loc, & + SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, & + SrcMeshID=SrcMesh%ID, SrcDispMeshID=SrcDispMesh%ID, & + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, & + DstMeshID=DstMesh%ID, DstDispMeshID=DstDispMesh%ID) - case ('AD HubLoad -> ED HubLoad') - call MeshMapCreate(T%AD%y%rotors(1)%HubLoad, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + ! Create mesh mapping + call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - case ('AD TFinLoad -> ED TFinLoad') - call MeshMapCreate(T%AD%y%rotors(1)%TFinLoad, T%ED%Input(1)%TFinCMLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return + ! Create a copy of destination mesh in mapping for load summation + call MeshCopy(DstMesh, Mapping%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - case ('AD TowerLoad -> ED TowerLoad') - call MeshMapCreate(T%AD%y%rotors(1)%TowerLoad, T%ED%Input(1)%TowerPtLoads, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%ED%Input(1)%TowerPtLoads, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] - case ('BD ReactionForce -> ED HubLoad') - call MeshMapCreate(T%BD%y(Maps(i)%DstIns)%ReactionForce, T%ED%Input(1)%HubPtLoad, Maps(i)%MeshMap, ErrStat2, ErrMsg2); if (MapFailed()) return - call MeshCopy(T%ED%Input(1)%HubPtLoad, Maps(i)%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (MapFailed()) return +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Key) + Failed = ErrStat >= AbortErrLev + end function +end subroutine - case ("SrvD Data -> ED Data") +subroutine MotionMeshMap(Mappings, Key, SrcMod, SrcMesh, & + DstMod, DstMesh, ErrStat, ErrMsg, i1, i2, Active) + type(TC_MappingType), allocatable :: Mappings(:) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + type(MeshType), intent(in) :: SrcMesh, DstMesh + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + integer(IntKi), optional, intent(in) :: i1, i2 + logical, optional, intent(in) :: Active - !---------------------------------------------------------------------- - ! InflowWind Inputs - !---------------------------------------------------------------------- + character(*), parameter :: RoutineName = 'MotionMeshMap' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i1Loc, i2Loc + type(TC_MappingType) :: Mapping - case ('ED HubMotion -> IfW HubMotion') + ErrStat = ErrID_None + ErrMsg = '' - !---------------------------------------------------------------------- - ! ServoDyn Inputs - !---------------------------------------------------------------------- + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if - case ("BD Data -> SrvD Data") - case ("BD RootM -> SrvD RootM") + ! Check that all meshes in mapping have nonzero identifiers + if (SrcMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'SrcMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + else if (DstMesh%ID == 0) then + call SetErrStat(ErrID_Fatal, 'DstMesh not in module variable', ErrStat, ErrMsg, RoutineName) + return + end if - case ("ED Data -> SrvD Data") - case ("ED RootM -> SrvD RootM") + ! Get optional mapping indicies + i1Loc = 0; if (present(i1)) i1Loc = i1 + i2Loc = 0; if (present(i2)) i2Loc = i2 - case ("IfW Data -> SrvD Data") + ! Initialize mapping structure + Mapping = TC_MappingType(Key=Key, Typ=Map_MotionMesh, i1=i1Loc, i2=i2Loc, & + SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshID=SrcMesh%ID, & + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshID=DstMesh%ID) - case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: '//Maps(i)%Key, ErrStat, ErrMsg, RoutineName) - return - end select + ! Create mesh mapping + call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return - ! Reset remap flags in mapping temporary meshe - if (associated(Maps(i)%MeshTmp%RemapFlag)) Maps(i)%MeshTmp%RemapFlag = .false. - end do + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] contains - subroutine MapLoadMesh(Key, SrcMod, SrcMeshName, SrcDispMeshName, & - DstMod, DstMeshName, DstDispMeshName, i1, i2, Active) - character(*), intent(in) :: Key - type(ModDataType), intent(in) :: SrcMod, DstMod - character(*), intent(in) :: SrcMeshName, DstMeshName - character(*), intent(in) :: SrcDispMeshName, DstDispMeshName - integer(IntKi), optional, intent(in) :: i1, i2 - logical, optional, intent(in) :: Active - integer(IntKi) :: i1Loc, i2Loc - if (present(Active)) then - if (.not. Active) return - end if - i1Loc = 0 - i2Loc = 0 - if (present(i1)) i1Loc = i1 - if (present(i2)) i2Loc = i2 - Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_LoadMesh, i1=i1Loc, i2=i2Loc, & - SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshName=SrcMeshName, SrcDispMeshName=SrcDispMeshName, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName, DstDispMeshName=DstDispMeshName)] - end subroutine - - subroutine MapMotionMesh(Key, SrcMod, SrcMeshName, & - DstMod, DstMeshName, i1, i2, Active) - character(*), intent(in) :: Key - type(ModDataType), intent(in) :: SrcMod, DstMod - character(*), intent(in) :: SrcMeshName, DstMeshName - integer(IntKi), optional, intent(in) :: i1, i2 - logical, optional, intent(in) :: Active - integer(IntKi) :: i1Loc, i2Loc - if (present(Active)) then - if (.not. Active) return - end if - i1Loc = 0 - i2Loc = 0 - if (present(i1)) i1Loc = i1 - if (present(i2)) i2Loc = i2 - Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_MotionMesh, i1=i1Loc, i2=i2Loc, & - SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshName=SrcMeshName, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshName=DstMeshName)] - end subroutine - - subroutine MapNonMesh(Key, SrcMod, DstMod, i1, i2, Active) - character(*), intent(in) :: Key - type(ModDataType), intent(in) :: SrcMod, DstMod - integer(IntKi), optional, intent(in) :: i1, i2 - logical, optional, intent(in) :: Active - integer(IntKi) :: i1Loc, i2Loc - if (present(Active)) then - if (.not. Active) return - end if - i1Loc = 0 - i2Loc = 0 - if (present(i1)) i1Loc = i1 - if (present(i2)) i2Loc = i2 - Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_NonMesh, i1=i1Loc, i2=i2Loc, & - SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins)] - end subroutine - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Key) Failed = ErrStat >= AbortErrLev end function +end subroutine - logical function MapFailed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Maps(i)%Key) - MapFailed = ErrStat >= AbortErrLev - end function +subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, i1, i2, Active) + type(TC_MappingType), allocatable :: Maps(:) + character(*), intent(in) :: Key + type(ModDataType), intent(in) :: SrcMod, DstMod + integer(IntKi), optional, intent(in) :: i1, i2 + logical, optional, intent(in) :: Active + integer(IntKi) :: i1Loc, i2Loc + if (present(Active)) then + if (.not. Active) return + end if + i1Loc = 0 + i2Loc = 0 + if (present(i1)) i1Loc = i1 + if (present(i2)) i2Loc = i2 + Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_NonMesh, i1=i1Loc, i2=i2Loc, & + SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, & + DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins)] end subroutine subroutine FAST_InputSolve(ModData, Maps, Dst, T, ErrStat, ErrMsg) @@ -951,6 +1038,12 @@ subroutine FAST_InputSolve(ModData, Maps, Dst, T, ErrStat, ErrMsg) else call IfW_InputSolve1(ModData, Maps, T%IfW%u, T, ErrStat2, ErrMsg2) end if + case (Module_SD) + if (Dst == IS_Input) then + call SD_InputSolve1(ModData, Maps, T%SD%Input(1), T, ErrStat2, ErrMsg2) + else + call SD_InputSolve1(ModData, Maps, T%SD%u, T, ErrStat2, ErrMsg2) + end if case (Module_SrvD) if (Dst == IS_Input) then call SrvD_InputSolve1(ModData, Maps, T%SrvD%Input(1), T, ErrStat2, ErrMsg2) @@ -1049,7 +1142,7 @@ subroutine AD_InputSolve1(ModData, Maps, u_AD, T, ErrStat, ErrMsg) ! end do case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) return end select end do @@ -1057,7 +1150,7 @@ subroutine AD_InputSolve1(ModData, Maps, u_AD, T, ErrStat, ErrMsg) contains logical function Failed() Failed = ErrStat2 /= ErrID_None - if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(Maps(i)%Key)//'"') end function end subroutine @@ -1107,7 +1200,7 @@ subroutine BD_InputSolve1(ModData, Maps, u_BD, T, ErrStat, ErrMsg) if (Failed()) return case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) return end select end do @@ -1115,7 +1208,7 @@ subroutine BD_InputSolve1(ModData, Maps, u_BD, T, ErrStat, ErrMsg) contains logical function Failed() Failed = ErrStat2 /= ErrID_None - if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(Maps(i)%Key)//'"') end function end subroutine @@ -1223,6 +1316,15 @@ subroutine ED_InputSolve1(ModData, Maps, u_ED, T, ErrStat, ErrMsg) if (Failed()) return call SumMeshLoads(Maps(i)%MeshTmp, u_ED%HubPtLoad, ResetHubLoads) + case ('SD Y1Mesh -> ED Platform') + call Transfer_Point_to_Point(T%SD%y%Y1mesh, & + Maps(i)%MeshTmp, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%SD%Input(1)%TPMesh, & + T%ED%y%PlatformPtMesh) + if (Failed()) return + call SumMeshLoads(Maps(i)%MeshTmp, u_ED%PlatformPtMesh, ResetPlatformLoads) + case ("SrvD Data -> ED Data") u_ED%GenTrq = T%SrvD%y%GenTrq u_ED%HSSBrTrqC = T%SrvD%y%HSSBrTrqC @@ -1230,14 +1332,14 @@ subroutine ED_InputSolve1(ModData, Maps, u_ED, T, ErrStat, ErrMsg) u_ED%YawMom = T%SrvD%y%YawMom case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) return end select end do contains logical function Failed() - if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + if (ErrStat2 /= ErrID_None) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(Maps(i)%Key)//'"') Failed = ErrStat >= AbortErrLev end function end subroutine @@ -1282,7 +1384,7 @@ subroutine IfW_InputSolve1(ModData, Maps, u_IfW, T, ErrStat, ErrMsg) u_IfW%lidar%HubDisplacementZ = T%ED%y%HubPtMotion%TranslationDisp(3, 1) case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) return end select end do @@ -1290,7 +1392,54 @@ subroutine IfW_InputSolve1(ModData, Maps, u_IfW, T, ErrStat, ErrMsg) contains logical function Failed() Failed = ErrStat2 /= ErrID_None - if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(Maps(i)%Key)//'"') + end function +end subroutine + +subroutine SD_InputSolve1(ModData, Maps, u_SD, T, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: u_SD + type(ModDataType), intent(in) :: ModData !< Module data + type(TC_MappingType), intent(inout) :: Maps(:) + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'SD_InputSolve' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mappings where this module is the destination + do j = 1, size(ModData%DstMaps) + + ! Get mapping index + i = ModData%DstMaps(j) + + ! If mapping source has not been calculated, cycle + if (.not. Maps(i)%Ready) cycle + + ! Switch based on mapping key + select case (Maps(i)%Key) + + case ('ED PlatformMotion -> SD TPMesh') + call Transfer_Point_to_Point(T%ED%y%PlatformPtMesh, u_SD%TPMesh, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case default + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) + return + end select + + if (Failed()) return + end do + +contains + logical function Failed() + Failed = ErrStat2 /= ErrID_None + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(Maps(i)%Key)//'"') end function end subroutine @@ -1394,7 +1543,7 @@ subroutine SrvD_InputSolve1(ModData, Maps, u_SrvD, T, ErrStat, ErrMsg) if (allocated(T%IfW%y%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = T%IfW%y%lidar%MsrPositionsZ case default - call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) return end select end do @@ -1405,7 +1554,7 @@ subroutine SrvD_InputSolve1(ModData, Maps, u_SrvD, T, ErrStat, ErrMsg) contains logical function Failed() Failed = ErrStat2 /= ErrID_None - if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//Maps(i)%Key//'"') + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(Maps(i)%Key)//'"') end function end subroutine @@ -1443,55 +1592,53 @@ subroutine FAST_CalcOutput(ModData, Maps, this_time, this_state, T, ErrStat, Err select case (ModData%ID) case (Module_AD) - call AD_CalcOutput(this_time, T%AD%Input(1), T%AD%p, T%AD%x(this_state), T%AD%xd(this_state), T%AD%z(this_state), & - T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep); if (Failed()) return + T%AD%OtherSt(this_state), T%AD%y, T%AD%m, ErrStat2, ErrMsg2, T%y_FAST%WriteThisStep) case (Module_BD) - call BD_CalcOutput(this_time, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), T%BD%x(ModData%Ins, this_state), & T%BD%xd(ModData%Ins, this_state), T%BD%z(ModData%Ins, this_state), T%BD%OtherSt(ModData%Ins, this_state), & - T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2); if (Failed()) return + T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2) case (Module_ED) - call ED_CalcOutput(this_time, T%ED%Input(1), T%ED%p, T%ED%x(this_state), T%ED%xd(this_state), & - T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2); if (Failed()) return + T%ED%z(this_state), T%ED%OtherSt(this_state), T%ED%y, T%ED%m, ErrStat2, ErrMsg2) ! case (Module_ExtPtfm) ! case (Module_FEAM) -! case (Module_HD) + case (Module_HD) + call HydroDyn_CalcOutput(this_time, T%HD%Input(1), T%HD%p, T%HD%x(this_state), T%HD%xd(this_state), & + T%HD%z(this_state), T%HD%OtherSt(this_state), T%HD%y, T%HD%m, ErrStat2, ErrMsg2) + ! case (Module_IceD) ! case (Module_IceF) case (Module_IfW) - - ! TODO: fix inconsistent function signature call InflowWind_CalcOutput(this_time, T%IfW%Input(1), T%IfW%p, T%IfW%x(this_state), T%IfW%xd(this_state), T%IfW%z(this_state), & - T%IfW%OtherSt(this_state), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2); if (Failed()) return + T%IfW%OtherSt(this_state), T%IfW%y, T%IfW%m, ErrStat2, ErrMsg2) ! case (Module_MAP) ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) -! case (Module_SD) + case (Module_SD) + call SD_CalcOutput(this_time, T%SD%Input(1), T%SD%p, T%SD%x(this_state), T%SD%xd(this_state), T%SD%z(this_state), & + T%SD%OtherSt(this_state), T%SD%y, T%SD%m, ErrStat2, ErrMsg2) + ! case (Module_SeaSt) case (Module_SrvD) - call SrvD_CalcOutput(this_time, T%SrvD%Input(1), T%SrvD%p, T%SrvD%x(this_state), T%SrvD%xd(this_state), T%SrvD%z(this_state), & - T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2); if (Failed()) return + T%SrvD%OtherSt(this_state), T%SrvD%y, T%SrvD%m, ErrStat2, ErrMsg2) case default call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) return end select + ! Check for errors during calc output call + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + ! Set updated flag in mappings where this module is the source Maps(ModData%SrcMaps)%Ready = .true. - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function end subroutine subroutine FAST_CalcContStateDeriv(ModData, ThisTime, ThisState, T, ErrStat, ErrMsg, dxdt) @@ -1537,7 +1684,16 @@ subroutine FAST_CalcContStateDeriv(ModData, ThisTime, ThisState, T, ErrStat, Err ! case (Module_ExtPtfm) ! case (Module_FEAM) -! case (Module_HD) + case (Module_HD) + + call HydroDyn_CalcContStateDeriv(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%m, & + T%HD%dxdt, ErrStat2, ErrMsg2); if (Failed()) return + if (present(dxdt)) then + call HD_PackStateValues(T%HD%p, T%HD%dxdt, T%HD%m%Vals%dxdt) + call XferLocToGbl1D(ModData%ixs, T%HD%m%Vals%dxdt, dxdt) + end if + ! case (Module_IceD) ! case (Module_IceF) ! case (Module_IfW) @@ -1545,7 +1701,16 @@ subroutine FAST_CalcContStateDeriv(ModData, ThisTime, ThisState, T, ErrStat, Err ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) -! case (Module_SD) + case (Module_SD) + + call SD_CalcContStateDeriv(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%m, & + T%SD%dxdt, ErrStat2, ErrMsg2); if (Failed()) return + if (present(dxdt)) then + call SD_PackStateValues(T%SD%p, T%SD%dxdt, T%SD%m%Vals%dxdt) + call XferLocToGbl1D(ModData%ixs, T%SD%m%Vals%dxdt, dxdt) + end if + ! case (Module_SeaSt) ! case (Module_SrvD) case default @@ -1632,7 +1797,27 @@ subroutine FAST_JacobianPInput(MD, ThisTime, ThisState, IsSolve, T, ErrStat, Err ! case (Module_ExtPtfm) ! case (Module_FEAM) -! case (Module_HD) + case (Module_HD) + + select case (Args) + case (1) + call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%HD%m%Vals%dYdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%HD%m%Vals%dYdu, dYdu) + case (2) + call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dXdu=T%HD%m%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%ixs, MD%ius, T%HD%m%Vals%dXdu, dXdu) + case (3) + call HD_JacobianPInput(ThisTime, T%HD%Input(1), T%HD%p, T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), T%HD%y, T%HD%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%HD%m%Vals%dYdu, dXdu=T%HD%m%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%HD%m%Vals%dYdu, dYdu) + call XferLocToGbl2D(MD%ixs, MD%ius, T%HD%m%Vals%dXdu, dXdu) + end select + ! case (Module_IceD) ! case (Module_IceF) ! case (Module_IfW) @@ -1640,7 +1825,28 @@ subroutine FAST_JacobianPInput(MD, ThisTime, ThisState, IsSolve, T, ErrStat, Err ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) -! case (Module_SD) + + case (Module_SD) + + select case (Args) + case (1) + call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%SD%m%Vals%dYdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%SD%m%Vals%dYdu, dYdu) + case (2) + call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dXdu=T%SD%m%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%ixs, MD%ius, T%SD%m%Vals%dXdu, dXdu) + case (3) + call SD_JacobianPInput(ThisTime, T%SD%Input(1), T%SD%p, T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), T%SD%y, T%SD%m, & + ErrStat2, ErrMsg2, IsSolve=IsSolve, dYdu=T%SD%m%Vals%dYdu, dXdu=T%SD%m%Vals%dXdu); if (Failed()) return + call XferLocToGbl2D(MD%iys, MD%ius, T%SD%m%Vals%dYdu, dYdu) + call XferLocToGbl2D(MD%ixs, MD%ius, T%SD%m%Vals%dXdu, dXdu) + end select + ! case (Module_SeaSt) ! case (Module_SrvD) case default @@ -1684,62 +1890,85 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, IsSolve, T, Err ! case (Module_AD) case (Module_BD) - select case (Args) case (1) call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - IsSolve=IsSolve, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx); if (Failed()) return + IsSolve=IsSolve, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) case (2) call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - IsSolve=IsSolve, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return + IsSolve=IsSolve, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) case (3) call BD_JacobianPContState(ThisTime, T%BD%Input(1, ModData%Ins), T%BD%p(ModData%Ins), & T%BD%x(ModData%Ins, ThisState), T%BD%xd(ModData%Ins, ThisState), & T%BD%z(ModData%Ins, ThisState), T%BD%OtherSt(ModData%Ins, ThisState), & T%BD%y(ModData%Ins), T%BD%m(ModData%Ins), ErrStat2, ErrMsg2, & - IsSolve=IsSolve, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx); if (Failed()) return + IsSolve=IsSolve, dYdx=T%BD%m(ModData%Ins)%Vals%dYdx, dXdx=T%BD%m(ModData%Ins)%Vals%dXdx) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dYdx, dYdx) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%BD%m(ModData%Ins)%Vals%dXdx, dXdx) end select case (Module_ED) - select case (Args) case (1) call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & T%ED%x(ThisState), T%ED%xd(ThisState), & T%ED%z(ThisState), T%ED%OtherSt(ThisState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - IsSolve=IsSolve, dYdx=T%ED%m%Vals%dYdx); if (Failed()) return + IsSolve=IsSolve, dYdx=T%ED%m%Vals%dYdx) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) case (2) call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & T%ED%x(ThisState), T%ED%xd(ThisState), & T%ED%z(ThisState), T%ED%OtherSt(ThisState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - IsSolve=IsSolve, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + IsSolve=IsSolve, dXdx=T%ED%m%Vals%dXdx) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) case (3) call ED_JacobianPContState(ThisTime, T%ED%Input(1), T%ED%p, & T%ED%x(ThisState), T%ED%xd(ThisState), & T%ED%z(ThisState), T%ED%OtherSt(ThisState), & T%ED%y, T%ED%m, ErrStat2, ErrMsg2, & - IsSolve=IsSolve, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx); if (Failed()) return + IsSolve=IsSolve, dYdx=T%ED%m%Vals%dYdx, dXdx=T%ED%m%Vals%dXdx) call XferLocToGbl2D(ModData%iys, ModData%ixs, T%ED%m%Vals%dYdx, dYdx) call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%ED%m%Vals%dXdx, dXdx) end select ! case (Module_ExtPtfm) ! case (Module_FEAM) -! case (Module_HD) + case (Module_HD) + select case (Args) + case (1) + call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & + T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%HD%m%Vals%dYdx) + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%HD%m%Vals%dYdx, dYdx) + case (2) + call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & + T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dXdx=T%HD%m%Vals%dXdx) + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%HD%m%Vals%dXdx, dXdx) + case (3) + call HD_JacobianPContState(ThisTime, T%HD%Input(1), T%HD%p, & + T%HD%x(ThisState), T%HD%xd(ThisState), & + T%HD%z(ThisState), T%HD%OtherSt(ThisState), & + T%HD%y, T%HD%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%HD%m%Vals%dYdx, dXdx=T%HD%m%Vals%dXdx) + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%HD%m%Vals%dYdx, dYdx) + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%HD%m%Vals%dXdx, dXdx) + end select + ! case (Module_IceD) ! case (Module_IceF) ! case (Module_IfW) @@ -1747,7 +1976,32 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, IsSolve, T, Err ! case (Module_MD) ! case (Module_OpFM) ! case (Module_Orca) -! case (Module_SD) + case (Module_SD) + select case (Args) + case (1) + call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & + T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%SD%m%Vals%dYdx) + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%SD%m%Vals%dYdx, dYdx) + case (2) + call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & + T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dXdx=T%SD%m%Vals%dXdx) + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%SD%m%Vals%dXdx, dXdx) + case (3) + call SD_JacobianPContState(ThisTime, T%SD%Input(1), T%SD%p, & + T%SD%x(ThisState), T%SD%xd(ThisState), & + T%SD%z(ThisState), T%SD%OtherSt(ThisState), & + T%SD%y, T%SD%m, ErrStat2, ErrMsg2, & + IsSolve=IsSolve, dYdx=T%SD%m%Vals%dYdx, dXdx=T%SD%m%Vals%dXdx) + call XferLocToGbl2D(ModData%iys, ModData%ixs, T%SD%m%Vals%dYdx, dYdx) + call XferLocToGbl2D(ModData%ixs, ModData%ixs, T%SD%m%Vals%dXdx, dXdx) + end select + ! case (Module_SeaSt) ! case (Module_SrvD) case default @@ -1755,11 +2009,7 @@ subroutine FAST_JacobianPContState(ModData, ThisTime, ThisState, IsSolve, T, Err return end select -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//ModData%Abbr) end subroutine subroutine FAST_SaveStates(ModData, T, ErrStat, ErrMsg) @@ -2086,25 +2336,33 @@ subroutine FAST_LinearizeMappings(ModData, ModOrder, Maps, T, ErrStat, ErrMsg, d select case (Maps(i)%Key) case ('ED BladeRoot -> BD RootMotion') - call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%DstIns), & - T%BD%Input(1, Maps(i)%DstIns)%RootMotion, & + call Linearize_Point_to_Point(T%ED%y%BladeRootMotion(Maps(i)%DstIns), T%BD%Input(1, Maps(i)%DstIns)%RootMotion, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2) + + case ('ED PlatformMotion -> SD TPMesh') + call Linearize_Point_to_Point(T%ED%y%PlatformPtMesh, T%SD%Input(1)%TPMesh, & Maps(i)%MeshMap, ErrStat2, ErrMsg2) - if (Failed()) return case ('BD ReactionForce -> ED HubLoad') - call Linearize_Point_to_Point(T%BD%y(Maps(i)%SrcIns)%ReactionForce, & - T%ED%u%HubPtLoad, & + call Linearize_Point_to_Point(T%BD%y(Maps(i)%SrcIns)%ReactionForce, T%ED%Input(1)%HubPtLoad, & Maps(i)%MeshMap, ErrStat2, ErrMsg2, & - T%BD%Input(1, Maps(i)%SrcIns)%RootMotion, & - T%ED%y%HubPtMotion) - if (Failed()) return + T%BD%Input(1, Maps(i)%SrcIns)%RootMotion, T%ED%y%HubPtMotion) + + case ('SD Y1Mesh -> ED Platform') + call Linearize_Point_to_Point(T%SD%y%Y1mesh, T%ED%Input(1)%PlatformPtMesh, & + Maps(i)%MeshMap, ErrStat2, ErrMsg2, & + T%SD%Input(1)%TPMesh, T%ED%y%PlatformPtMesh) case default cycle ! TODO: remove cycle and restore error, all mapping should be linearized - ! call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//Maps(i)%Key//'"', ErrStat, ErrMsg, RoutineName) + ! call SetErrStat(ErrID_Fatal, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) ! return end select + ! Check for errors + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (present(dUdu)) then call dUduSetBlocks(Maps(i), ModData(Maps(i)%SrcModIdx), ModData(Maps(i)%DstModIdx), Maps(i)%MeshMap%dM) end if @@ -2215,11 +2473,6 @@ subroutine SetBlock(RowVars, RowField, ColVars, ColField, Loc, Gbl) m = m + mSize end do end subroutine - - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function end subroutine end module diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 2f5593bf70..4272ae3755 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -95,26 +95,26 @@ param ^ - IntKi Map_LoadMesh - 1 - "L param ^ - IntKi Map_MotionMesh - 2 - "Motion mesh mapping type" - param ^ - IntKi Map_NonMesh - 3 - "Non mesh mapping type" - typedef ^ TC_MappingType character(VarNameLen) Key - '' - "Mapping Key" - -typedef ^ ^ character(VarNameLen) SrcMeshName - '' - "source mesh name" - -typedef ^ ^ character(VarNameLen) DstMeshName - '' - "destination mesh name" - -typedef ^ ^ character(VarNameLen) SrcDispMeshName - '' - "source displacement mesh name [if IsLoad=true]" - -typedef ^ ^ character(VarNameLen) DstDispMeshName - '' - "destination displacement mesh name [if IsLoad=true]" - typedef ^ ^ IntKi i1 - 0 - "Optional index for specifying transfers" - typedef ^ ^ IntKi i2 - 0 - "Optional index for specifying transfers" - -typedef ^ ^ IntKi SrcModIdx - 0 - "Output module index in ModData array" - -typedef ^ ^ IntKi DstModIdx - 0 - "Input module index in ModData array" - -typedef ^ ^ IntKi SrcModID - 0 - "Output module ID" - -typedef ^ ^ IntKi DstModID - 0 - "Input module ID" - -typedef ^ ^ IntKi SrcIns - 0 - "Output module Instance" - -typedef ^ ^ IntKi DstIns - 0 - "Input module Instance" - -typedef ^ ^ IntKi SrcVarIdx : - - "motion variable index" - -typedef ^ ^ IntKi DstVarIdx : - - "motion variable index" - -typedef ^ ^ IntKi SrcDispVarIdx - 0 - "source displacement var index [if IsLoad=true]" - -typedef ^ ^ IntKi DstDispVarIdx - 0 - "destination displacement var index [if IsLoad=true]" - +typedef ^ ^ IntKi SrcModIdx - 0 - "Source module index in ModData array" - +typedef ^ ^ IntKi DstModIdx - 0 - "Destination module index in ModData array" - +typedef ^ ^ IntKi SrcModID - 0 - "Source module ID" - +typedef ^ ^ IntKi DstModID - 0 - "Destination module ID" - +typedef ^ ^ IntKi SrcIns - 0 - "Source module Instance" - +typedef ^ ^ IntKi DstIns - 0 - "Destination module Instance" - +typedef ^ ^ IntKi SrcMeshID - 0 - "Source mesh identifier" - +typedef ^ ^ IntKi DstMeshID - 0 - "Destination mesh identifier" - +typedef ^ ^ IntKi SrcVarIdx : - - "Source motion variable index" - +typedef ^ ^ IntKi DstVarIdx : - - "Destination motion variable index" - +typedef ^ ^ IntKi SrcDispMeshID - 0 - "Source displacement mesh identifier" - +typedef ^ ^ IntKi DstDispMeshID - 0 - "Destination displacement mesh identifier" - +typedef ^ ^ IntKi SrcDispVarIdx - 0 - "Source displacement var index [if Typ=Map_LoadMesh]" - +typedef ^ ^ IntKi DstDispVarIdx - 0 - "Destination displacement var index [if Typ=Map_LoadMesh]" - typedef ^ ^ IntKi Typ - 0 - "Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh)" - -typedef ^ ^ logical Ready - F - "Flag indicating output has been ready to be transferred" - +typedef ^ ^ logical Ready - F - "Flag indicating Source has been ready to be transferred" - typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - -typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from output variable to input variable" - +typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - # Parameters typedef ^ TC_ParameterType R8Ki DT - - - "solution time step" - @@ -616,6 +616,7 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {2} - - "Continuous states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType dxdt - - - "Continuous state derivatives" typedef ^ ^ HydroDyn_DiscreteStateType xd {2} - - "Discrete states" typedef ^ ^ HydroDyn_ConstraintStateType z {2} - - "Constraint states" typedef ^ ^ HydroDyn_OtherStateType OtherSt {2} - - "Other states" diff --git a/modules/openfast-library/src/FAST_Subs_TC.f90 b/modules/openfast-library/src/FAST_Subs_TC.f90 index f145608ab9..c4e5bfef21 100644 --- a/modules/openfast-library/src/FAST_Subs_TC.f90 +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -822,6 +822,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Add module instance to array of modules + CALL MV_AddModule(m_FAST%Modules, Module_SeaSt, 'SeaSt', 1, p_FAST%dt_module(Module_SeaSt), p_FAST%DT, Init%OutData_SeaSt%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -887,6 +891,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Add module instance to array of modules + CALL MV_AddModule(m_FAST%Modules, Module_HD, 'HD', 1, p_FAST%dt_module(Module_HD), p_FAST%DT, Init%OutData_HD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -953,6 +961,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_SD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Add module instance to array of modules + CALL MV_AddModule(m_FAST%Modules, Module_SD, 'SD', 1, p_FAST%dt_module(Module_SD), p_FAST%DT, Init%OutData_SD%Vars, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + allocate( y_FAST%Lin%Modules(MODULE_SD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SD).", ErrStat, ErrMsg, RoutineName ) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index f275c59de4..c70c1007be 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -115,26 +115,26 @@ MODULE FAST_Types ! ========= TC_MappingType ======= TYPE, PUBLIC :: TC_MappingType character(VarNameLen) :: Key = '' !< Mapping Key [-] - character(VarNameLen) :: SrcMeshName = '' !< source mesh name [-] - character(VarNameLen) :: DstMeshName = '' !< destination mesh name [-] - character(VarNameLen) :: SrcDispMeshName = '' !< source displacement mesh name [if IsLoad=true] [-] - character(VarNameLen) :: DstDispMeshName = '' !< destination displacement mesh name [if IsLoad=true] [-] INTEGER(IntKi) :: i1 = 0 !< Optional index for specifying transfers [-] INTEGER(IntKi) :: i2 = 0 !< Optional index for specifying transfers [-] - INTEGER(IntKi) :: SrcModIdx = 0 !< Output module index in ModData array [-] - INTEGER(IntKi) :: DstModIdx = 0 !< Input module index in ModData array [-] - INTEGER(IntKi) :: SrcModID = 0 !< Output module ID [-] - INTEGER(IntKi) :: DstModID = 0 !< Input module ID [-] - INTEGER(IntKi) :: SrcIns = 0 !< Output module Instance [-] - INTEGER(IntKi) :: DstIns = 0 !< Input module Instance [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcVarIdx !< motion variable index [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstVarIdx !< motion variable index [-] - INTEGER(IntKi) :: SrcDispVarIdx = 0 !< source displacement var index [if IsLoad=true] [-] - INTEGER(IntKi) :: DstDispVarIdx = 0 !< destination displacement var index [if IsLoad=true] [-] + INTEGER(IntKi) :: SrcModIdx = 0 !< Source module index in ModData array [-] + INTEGER(IntKi) :: DstModIdx = 0 !< Destination module index in ModData array [-] + INTEGER(IntKi) :: SrcModID = 0 !< Source module ID [-] + INTEGER(IntKi) :: DstModID = 0 !< Destination module ID [-] + INTEGER(IntKi) :: SrcIns = 0 !< Source module Instance [-] + INTEGER(IntKi) :: DstIns = 0 !< Destination module Instance [-] + INTEGER(IntKi) :: SrcMeshID = 0 !< Source mesh identifier [-] + INTEGER(IntKi) :: DstMeshID = 0 !< Destination mesh identifier [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcVarIdx !< Source motion variable index [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstVarIdx !< Destination motion variable index [-] + INTEGER(IntKi) :: SrcDispMeshID = 0 !< Source displacement mesh identifier [-] + INTEGER(IntKi) :: DstDispMeshID = 0 !< Destination displacement mesh identifier [-] + INTEGER(IntKi) :: SrcDispVarIdx = 0 !< Source displacement var index [if Typ=Map_LoadMesh] [-] + INTEGER(IntKi) :: DstDispVarIdx = 0 !< Destination displacement var index [if Typ=Map_LoadMesh] [-] INTEGER(IntKi) :: Typ = 0 !< Integer denoting mapping type (1=Load Mesh, 2=Motion Mesh, 3=Non-Mesh) [-] - LOGICAL :: Ready = .false. !< Flag indicating output has been ready to be transferred [-] + LOGICAL :: Ready = .false. !< Flag indicating Source has been ready to be transferred [-] TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] - TYPE(MeshMapType) :: MeshMap !< Mesh mapping from output variable to input variable [-] + TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] END TYPE TC_MappingType ! ======================= ! ========= TC_ParameterType ======= @@ -641,6 +641,7 @@ MODULE FAST_Types ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(HydroDyn_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] TYPE(HydroDyn_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] @@ -1527,10 +1528,6 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, ErrStat = ErrID_None ErrMsg = '' DstTC_MappingTypeData%Key = SrcTC_MappingTypeData%Key - DstTC_MappingTypeData%SrcMeshName = SrcTC_MappingTypeData%SrcMeshName - DstTC_MappingTypeData%DstMeshName = SrcTC_MappingTypeData%DstMeshName - DstTC_MappingTypeData%SrcDispMeshName = SrcTC_MappingTypeData%SrcDispMeshName - DstTC_MappingTypeData%DstDispMeshName = SrcTC_MappingTypeData%DstDispMeshName DstTC_MappingTypeData%i1 = SrcTC_MappingTypeData%i1 DstTC_MappingTypeData%i2 = SrcTC_MappingTypeData%i2 DstTC_MappingTypeData%SrcModIdx = SrcTC_MappingTypeData%SrcModIdx @@ -1539,6 +1536,8 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, DstTC_MappingTypeData%DstModID = SrcTC_MappingTypeData%DstModID DstTC_MappingTypeData%SrcIns = SrcTC_MappingTypeData%SrcIns DstTC_MappingTypeData%DstIns = SrcTC_MappingTypeData%DstIns + DstTC_MappingTypeData%SrcMeshID = SrcTC_MappingTypeData%SrcMeshID + DstTC_MappingTypeData%DstMeshID = SrcTC_MappingTypeData%DstMeshID if (allocated(SrcTC_MappingTypeData%SrcVarIdx)) then LB(1:1) = lbound(SrcTC_MappingTypeData%SrcVarIdx) UB(1:1) = ubound(SrcTC_MappingTypeData%SrcVarIdx) @@ -1563,6 +1562,8 @@ subroutine FAST_CopyTC_MappingType(SrcTC_MappingTypeData, DstTC_MappingTypeData, end if DstTC_MappingTypeData%DstVarIdx = SrcTC_MappingTypeData%DstVarIdx end if + DstTC_MappingTypeData%SrcDispMeshID = SrcTC_MappingTypeData%SrcDispMeshID + DstTC_MappingTypeData%DstDispMeshID = SrcTC_MappingTypeData%DstDispMeshID DstTC_MappingTypeData%SrcDispVarIdx = SrcTC_MappingTypeData%SrcDispVarIdx DstTC_MappingTypeData%DstDispVarIdx = SrcTC_MappingTypeData%DstDispVarIdx DstTC_MappingTypeData%Typ = SrcTC_MappingTypeData%Typ @@ -1602,10 +1603,6 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackTC_MappingType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Key) - call RegPack(Buf, InData%SrcMeshName) - call RegPack(Buf, InData%DstMeshName) - call RegPack(Buf, InData%SrcDispMeshName) - call RegPack(Buf, InData%DstDispMeshName) call RegPack(Buf, InData%i1) call RegPack(Buf, InData%i2) call RegPack(Buf, InData%SrcModIdx) @@ -1614,6 +1611,8 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) call RegPack(Buf, InData%DstModID) call RegPack(Buf, InData%SrcIns) call RegPack(Buf, InData%DstIns) + call RegPack(Buf, InData%SrcMeshID) + call RegPack(Buf, InData%DstMeshID) call RegPack(Buf, allocated(InData%SrcVarIdx)) if (allocated(InData%SrcVarIdx)) then call RegPackBounds(Buf, 1, lbound(InData%SrcVarIdx), ubound(InData%SrcVarIdx)) @@ -1624,6 +1623,8 @@ subroutine FAST_PackTC_MappingType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%DstVarIdx), ubound(InData%DstVarIdx)) call RegPack(Buf, InData%DstVarIdx) end if + call RegPack(Buf, InData%SrcDispMeshID) + call RegPack(Buf, InData%DstDispMeshID) call RegPack(Buf, InData%SrcDispVarIdx) call RegPack(Buf, InData%DstDispVarIdx) call RegPack(Buf, InData%Typ) @@ -1643,14 +1644,6 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Key) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SrcMeshName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DstMeshName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SrcDispMeshName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DstDispMeshName) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%i1) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%i2) @@ -1667,6 +1660,10 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstIns) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SrcMeshID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstMeshID) + if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%SrcVarIdx)) deallocate(OutData%SrcVarIdx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1695,6 +1692,10 @@ subroutine FAST_UnPackTC_MappingType(Buf, OutData) call RegUnpack(Buf, OutData%DstVarIdx) if (RegCheckErr(Buf, RoutineName)) return end if + call RegUnpack(Buf, OutData%SrcDispMeshID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DstDispMeshID) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SrcDispVarIdx) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DstDispVarIdx) @@ -12433,6 +12434,9 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + call HydroDyn_CopyContState(SrcHydroDyn_DataData%dxdt, DstHydroDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return LB(1:1) = lbound(SrcHydroDyn_DataData%xd) UB(1:1) = ubound(SrcHydroDyn_DataData%xd) do i1 = LB(1), UB(1) @@ -12532,6 +12536,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + call HydroDyn_DestroyContState(HydroDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) LB(1:1) = lbound(HydroDyn_DataData%xd) UB(1:1) = ubound(HydroDyn_DataData%xd) do i1 = LB(1), UB(1) @@ -12595,6 +12601,7 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call HydroDyn_PackContState(Buf, InData%x(i1)) end do + call HydroDyn_PackContState(Buf, InData%dxdt) LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) @@ -12655,6 +12662,7 @@ subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) do i1 = LB(1), UB(1) call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x end do + call HydroDyn_UnpackContState(Buf, OutData%dxdt) ! dxdt LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 8db1d90c86..d3680642c1 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -26,7 +26,7 @@ module Solver integer(IntKi), parameter :: TC_Modules(*) = [Module_ED, Module_BD, Module_SD] ! Debugging -logical, parameter :: DebugSolver = .true. +logical, parameter :: DebugSolver = .false. integer(IntKi) :: DebugUn = -1 character(*), parameter :: DebugFile = 'solver.dbg' logical, parameter :: DebugJacobian = .false. @@ -284,8 +284,10 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, vec2 = [vec2, Mod%Vars%x(j)%iSol] end do call AllocAry(Mod%ixs, 2, size(vec1), "Mod%ixs", ErrStat2, ErrMsg2); if (Failed()) return - Mod%ixs(1, :) = vec1 - Mod%ixs(2, :) = vec2 + if (size(vec1) > 0) then + Mod%ixs(1, :) = vec1 + Mod%ixs(2, :) = vec2 + end if end associate deallocate (vec1, vec2) end do @@ -329,8 +331,10 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, end select end do call AllocAry(Mods(i)%ius, 2, size(vec1), "Mods(i)%ius", ErrStat2, ErrMsg2); if (Failed()) return - Mods(i)%ius(1, :) = vec1 - Mods(i)%ius(2, :) = vec2 + if (size(vec1) > 0) then + Mods(i)%ius(1, :) = vec1 + Mods(i)%ius(2, :) = vec2 + end if deallocate (vec1, vec2) end do @@ -366,8 +370,10 @@ subroutine CalcVarGlobalIndices(p, Mods, NumX, NumU, NumY, NumQ, NumJ, ErrStat, vec2 = [vec2, Mods(i)%Vars%y(j)%iSol] end do call AllocAry(Mods(i)%iys, 2, size(vec1), "Mods(i)%iys", ErrStat2, ErrMsg2); if (Failed()) return - Mods(i)%iys(1, :) = vec1 - Mods(i)%iys(2, :) = vec2 + if (size(vec1) > 0) then + Mods(i)%iys(1, :) = vec1 + Mods(i)%iys(2, :) = vec2 + end if deallocate (vec1, vec2) end do @@ -1260,15 +1266,15 @@ subroutine PackModuleStates(ModData, this_state, T, x) do j = 1, size(ModData) ii = ModData(j)%Ins select case (ModData(j)%ID) - case (Module_ED) - call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) - call XferLocToGbl1D(ModData(j)%ixs, T%ED%m%Vals%x, x) case (Module_BD) call BD_PackStateValues(T%BD%p(ii), T%BD%x(ii, this_state), T%BD%m(ii)%Vals%x) call XferLocToGbl1D(ModData(j)%ixs, T%BD%m(ii)%Vals%x, x) + case (Module_ED) + call ED_PackStateValues(T%ED%p, T%ED%x(this_state), T%ED%m%Vals%x) + call XferLocToGbl1D(ModData(j)%ixs, T%ED%m%Vals%x, x) case (Module_SD) - ! call SD_PackStateValues(SD%p, SD%x(this_state), SD%m%Vals%x) - ! x(SD%p%Vars%ix) = SD%m%Vals%x + call SD_PackStateValues(T%SD%p, T%SD%x(this_state), T%SD%m%Vals%x) + call XferLocToGbl1D(ModData(j)%ixs, T%SD%m%Vals%x, x) end select end do @@ -1282,17 +1288,19 @@ subroutine UnpackModuleStates(ModData, ModOrder, this_state, T, x) real(R8Ki), intent(inout) :: x(:) integer(IntKi) :: j + ! Must support all Tight Coupling modules do j = 1, size(ModOrder) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) - case (Module_ED) - call XferGblToLoc1D(Mod%ixs, x, T%ED%m%Vals%x) - call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(this_state)) case (Module_BD) call XferGblToLoc1D(Mod%ixs, x, T%BD%m(Mod%Ins)%Vals%x) call BD_UnpackStateValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%x, T%BD%x(Mod%Ins, this_state)) + case (Module_ED) + call XferGblToLoc1D(Mod%ixs, x, T%ED%m%Vals%x) + call ED_UnpackStateValues(T%ED%p, T%ED%m%Vals%x, T%ED%x(this_state)) case (Module_SD) - ! call SD_UnpackStateValues(SD%p, x(SD%p%Vars%ix), SD%x(this_state)) + call XferGblToLoc1D(Mod%ixs, x, T%SD%m%Vals%x) + call SD_UnpackStateValues(T%SD%p, T%SD%m%Vals%x, T%SD%x(this_state)) end select end associate end do @@ -1309,15 +1317,24 @@ subroutine PackModuleInputs(ModData, ModOrder, T, u) do j = 1, size(ModOrder) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) - case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) - call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) case (Module_BD) call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) + case (Module_ExtPtfm) + ! call ExtPtfm_PackInputValues(T%ExtPtfm%p, T%ExtPtfm%Input(1), T%ExtPtfm%m%Vals%u) + ! call XferLocToGbl1D(Mod%ius, T%ExtPtfm%m%Vals%u, u) + case (Module_Orca) + ! call Orca_PackInputValues(T%Orca%p, T%Orca%Input(1), T%Orca%m%Vals%u) + ! call XferLocToGbl1D(Mod%ius, T%Orca%m%Vals%u, u) + case (Module_HD) + call HD_PackInputValues(T%HD%p, T%HD%Input(1), T%HD%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%HD%m%Vals%u, u) case (Module_SD) - ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) - ! u(SD%p%Vars%iu) = SD%m%Vals%u + call SD_PackInputValues(T%SD%p, T%SD%Input(1), T%SD%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%SD%m%Vals%u, u) end select end associate end do @@ -1335,15 +1352,24 @@ subroutine PackModuleUs(ModData, ModOrder, T, u) do j = 1, size(ModOrder) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) - case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%u, T%ED%m%Vals%u) - call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) case (Module_BD) call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%u(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) call XferLocToGbl1D(Mod%ius, T%BD%m(Mod%Ins)%Vals%u, u) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%u, T%ED%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%ED%m%Vals%u, u) + case (Module_ExtPtfm) + ! call ExtPtfm_PackInputValues(T%ExtPtfm%p, T%ExtPtfm%u, T%ExtPtfm%m%Vals%u) + ! call XferLocToGbl1D(Mod%ius, T%ExtPtfm%m%Vals%u, u) + case (Module_Orca) + ! call Orca_PackInputValues(T%Orca%p, T%Orca%u, T%Orca%m%Vals%u) + ! call XferLocToGbl1D(Mod%ius, T%Orca%m%Vals%u, u) + case (Module_HD) + call HD_PackInputValues(T%HD%p, T%HD%u, T%HD%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%HD%m%Vals%u, u) case (Module_SD) - ! call SD_PackInputValues(SD%p, SD%Input, SD%m%Vals%u) - ! u(SD%p%Vars%iu) = SD%m%Vals%u + call SD_PackInputValues(T%SD%p, T%SD%u, T%SD%m%Vals%u) + call XferLocToGbl1D(Mod%ius, T%SD%m%Vals%u, u) end select end associate end do @@ -1361,16 +1387,30 @@ subroutine UnpackModuleInputs(ModData, ModOrder, T, u) do j = 1, size(ModOrder) associate (Mod => ModData(ModOrder(j))) select case (Mod%ID) - case (Module_ED) - call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) - call XferGblToLoc1D(Mod%ius, u, T%ED%m%Vals%u) - call ED_UnpackInputValues(T%ED%p, T%ED%m%Vals%u, T%ED%Input(1)) case (Module_BD) call BD_PackInputValues(T%BD%p(Mod%Ins), T%BD%Input(1, Mod%Ins), T%BD%m(Mod%Ins)%Vals%u) call XferGblToLoc1D(Mod%ius, u, T%BD%m(Mod%Ins)%Vals%u) call BD_UnpackInputValues(T%BD%p(Mod%Ins), T%BD%m(Mod%Ins)%Vals%u, T%BD%Input(1, Mod%Ins)) + case (Module_ED) + call ED_PackInputValues(T%ED%p, T%ED%Input(1), T%ED%m%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%ED%m%Vals%u) + call ED_UnpackInputValues(T%ED%p, T%ED%m%Vals%u, T%ED%Input(1)) + case (Module_ExtPtfm) + ! call ExtPtfm_PackInputValues(T%ExtPtfm%p, T%ExtPtfm%Input(1), T%ExtPtfm%m%Vals%u) + ! call XferGblToLoc1D(Mod%ius, u, T%ExtPtfm%m%Vals%u) + ! call ExtPtfm_UnpackInputValues(T%ExtPtfm%p, T%ExtPtfm%m%Vals%u, T%ExtPtfm%Input(1)) + case (Module_Orca) + ! call Orca_PackInputValues(T%Orca%p, T%Orca%Input(1), T%Orca%m%Vals%u) + ! call XferGblToLoc1D(Mod%ius, u, T%Orca%m%Vals%u) + ! call Orca_UnpackInputValues(T%Orca%p, T%Orca%m%Vals%u, T%Orca%Input(1)) + case (Module_HD) + call HD_PackInputValues(T%HD%p, T%HD%Input(1), T%HD%m%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%HD%m%Vals%u) + call HD_UnpackInputValues(T%HD%p, T%HD%m%Vals%u, T%HD%Input(1)) case (Module_SD) - ! call SD_UnpackInputValues(SD%p, u(SD%p%Vars%iu), SD%Input(1)) + call SD_PackInputValues(T%SD%p, T%SD%Input(1), T%SD%m%Vals%u) + call XferGblToLoc1D(Mod%ius, u, T%SD%m%Vals%u) + call SD_UnpackInputValues(T%SD%p, T%SD%m%Vals%u, T%SD%Input(1)) end select end associate end do diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index e12645a9fd..c4fff25922 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -647,6 +647,9 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init end if + ! Initialize modules + CALL Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Destroy the local initialization data CALL CleanUp() @@ -682,6 +685,72 @@ END SUBROUTINE CleanUp !................................ END SUBROUTINE SeaSt_Init +subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, InputFileData, ErrStat, ErrMsg) + TYPE(SeaSt_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(SeaSt_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SeaSt_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SeaSt_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) + TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine + TYPE(SeaSt_InputFile), INTENT(IN ) :: InputFileData !< Input file data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Init_ModuleVars' + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + integer(IntKi) :: i, j, k, idx + REAL(R8Ki) :: MaxThrust, MaxTorque, ScaleLength + TYPE(ModVarType) :: Var + + ! Allocate space for variables (deallocate if already allocated) + if (associated(p%Vars)) deallocate(p%Vars) + allocate(p%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating p%Vars", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Associate pointers in initialization output + InitOut%Vars => p%Vars + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! call MV_AddVar(p%Vars%y, "Outputs", VF_Scalar, p%NumOuts, & + ! LinNames=[(trim(InitOut%WriteOutputHdr(i))//', '//& + ! trim(InitOut%WriteOutputUnt(i)), i=1,p%NumOuts)]) + + !---------------------------------------------------------------------------- + ! Initialize Variables and Values + !---------------------------------------------------------------------------- + + CALL MV_InitVarsVals(p%Vars, m%Vals, InitInp%Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + ! If linearization is not requested, return + if (.not. InitInp%Linearize) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 64f94c59dc..1509768d11 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -72,6 +72,7 @@ typedef ^ ^ Logical Lin typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" +typedef ^ ^ ModVarsType *Vars - - - "Module variables for solver and linearization" typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (m) @@ -133,7 +134,8 @@ typedef ^ OtherStateType R8Ki Unu # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - +typedef ^ MiscVarType ModValsType Vals - - - "Module values for solver and linearization" - +typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - @@ -142,7 +144,8 @@ typedef ^ ^ SeaSt_Interp_MiscVarType # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType Waves2_ParameterType Waves2 - - - "Parameter data for the Waves2 module" - +typedef ^ ParameterType ModVarsType &Vars - - - "Module variables for solver and linearization" - +typedef ^ ^ Waves2_ParameterType Waves2 - - - "Parameter data for the Waves2 module" - typedef ^ ^ SiKi WaveTime {*} - - "Array of time samples, (sec)" - typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 4bbcd889d9..7fc57d6b55 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -93,6 +93,7 @@ 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 [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module variables for solver and linearization [-] 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)] @@ -157,6 +158,7 @@ MODULE SeaState_Types ! ======================= ! ========= SeaSt_MiscVarType ======= TYPE, PUBLIC :: SeaSt_MiscVarType + TYPE(ModValsType) :: Vals !< Module values for solver and linearization [-] 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 [-] @@ -165,6 +167,7 @@ MODULE SeaState_Types ! ======================= ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Module variables for solver and linearization [-] TYPE(Waves2_ParameterType) :: Waves2 !< Parameter data for the Waves2 module [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] @@ -736,6 +739,7 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%Vars => SrcInitOutputData%Vars DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL @@ -808,6 +812,7 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%Vars) nullify(InitOutputData%WaveElevC0) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveDirArr) @@ -848,6 +853,13 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%MSL2SWL) @@ -1045,6 +1057,26 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) @@ -1653,6 +1685,9 @@ subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_CopyModValsType(SrcMiscData%Vals, DstMiscData%Vals, 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 @@ -1670,6 +1705,8 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyModValsType(MiscData%Vals, 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 @@ -1679,6 +1716,7 @@ subroutine SeaSt_PackMisc(Buf, Indata) type(SeaSt_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackMisc' if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModValsType(Buf, InData%Vals) call RegPack(Buf, InData%Decimate) call RegPack(Buf, InData%LastOutTime) call RegPack(Buf, InData%LastIndWave) @@ -1691,6 +1729,7 @@ subroutine SeaSt_UnPackMisc(Buf, OutData) type(SeaSt_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals call RegUnpack(Buf, OutData%Decimate) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%LastOutTime) @@ -1713,6 +1752,18 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'SeaSt_CopyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(SrcParamData%Vars)) then + if (.not. associated(DstParamData%Vars)) then + allocate(DstParamData%Vars, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Vars.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call NWTC_Library_CopyModVarsType(SrcParamData%Vars, DstParamData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if call Waves2_CopyParam(SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1853,6 +1904,12 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + if (associated(ParamData%Vars)) then + call NWTC_Library_DestroyModVarsType(ParamData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%Vars) + ParamData%Vars => null() + end if call Waves2_DestroyParam(ParamData%Waves2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%WaveTime) @@ -1910,6 +1967,13 @@ subroutine SeaSt_PackParam(Buf, Indata) integer(IntKi) :: LB(5), UB(5) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(Buf, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(Buf, InData%Vars) + end if + end if call Waves2_PackParam(Buf, InData%Waves2) call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then @@ -2091,6 +2155,26 @@ subroutine SeaSt_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + 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%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(Buf, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if call Waves2_UnpackParam(Buf, OutData%Waves2) ! Waves2 if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 1387a3a0d7..aa5dd3d478 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -48,6 +48,8 @@ Module SubDyn PUBLIC :: SD_JacobianPConstrState ! PUBLIC :: SD_GetOP ! PUBLIC :: SD_ProgDesc + PUBLIC :: SD_PackStateValues, SD_PackInputValues, SD_PackOutputValues + PUBLIC :: SD_UnpackStateValues, SD_UnpackInputValues CONTAINS @@ -391,7 +393,7 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO endif ! Initialize module variables - call Init_ModuleVars(InitInput, u, p, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return + call Init_ModuleVars(Init, InitInput, u, p, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return ! Tell GLUECODE the SubDyn timestep interval Interval = p%SDdeltaT @@ -418,11 +420,12 @@ END SUBROUTINE SD_Init !---------------------------------------------------------------------------------------------------------------------------------- !> Init_ModuleVars initializes the variables for this module for use by the solver and linearization -subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) +subroutine Init_ModuleVars(Init, InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) + TYPE(SD_InitType), INTENT(IN ) :: Init !< Input data for initialization routine TYPE(SD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(SD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(SD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SD_OutputType), INTENT(IN) :: y !< Initial system outputs (outputs are not calculated; + TYPE(SD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOut !< Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -432,9 +435,8 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - integer(IntKi) :: i, j, flags - REAL(R8Ki) :: MaxThrust, MaxTorque - CHARACTER(200) :: Describe + integer(IntKi) :: i, j + real(ReKi) :: dx, dy, dz, maxDim ! Allocate space for variables (deallocate if already allocated) if (associated(p%Vars)) deallocate(p%Vars) @@ -451,14 +453,46 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) ! Continuous State Variables !---------------------------------------------------------------------------- + call MV_AddVar(p%Vars%x, "Modes", VF_Scalar, p%nDOFM, jUsr=1, DerivOrder=0, & + Perturb=2.0_ReKi*D2R_D, & + LinNames=[('Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -', i=1, p%nDOFM)]) + + call MV_AddVar(p%Vars%x, "Modes", VF_Scalar, p%nDOFM, jUsr=2, DerivOrder=1, & + Perturb=2.0_ReKi*D2R_D, & + LinNames=[('First time derivative of Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -/s', i=1, p%nDOFM)]) + !---------------------------------------------------------------------------- ! Input variables !---------------------------------------------------------------------------- + + dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) + dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) + dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) + maxDim = max(dx, dy, dz) + + call MV_AddMeshVar(p%Vars%u, "TPMesh", MotionFields, Mesh=u%TPMesh, & + Perturbs=[2.0_R8Ki*D2R_D, & ! TranslationDisp + 2.0_R8Ki*D2R_D, & ! Orientation + 2.0_R8Ki*D2R_D, & ! TranslationVel + 2.0_R8Ki*D2R_D, & ! RotationVel + 2.0_R8Ki*D2R_D, & ! TranslationAcc + 2.0_R8Ki*D2R_D]) ! RotationAcc + call MV_AddMeshVar(p%Vars%u, "LMesh", LoadFields, Mesh=u%LMesh, & + Perturbs=[170*maxDim**2, 14*maxDim**3]) ! Force, Moment !---------------------------------------------------------------------------- ! Output variables !---------------------------------------------------------------------------- + ! Mesh variables + call MV_AddMeshVar(p%Vars%y, 'Y1Mesh', LoadFields, Mesh=y%Y1Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y2Mesh', MotionFields, Mesh=y%Y2Mesh) + call MV_AddMeshVar(p%Vars%y, 'Y3Mesh', MotionFields, Mesh=y%Y3Mesh) + + ! Output variables + call MV_AddVar(p%Vars%y, "Outputs", VF_Scalar, Num=p%NumOuts, & + LinNames=OutputLinNames(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt)) + !---------------------------------------------------------------------------- ! Initialize Variables and Values !---------------------------------------------------------------------------- @@ -470,19 +504,17 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) !---------------------------------------------------------------------------- ! If linearization is not requested, return - ! if (.not. InitInp%Linearize) return - ! TODO: Use variables for linearization - return + if (.not. InitInp%Linearize) return ! State Variables call AllocAry(InitOut%LinNames_x, p%Vars%Nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(InitOut%RotFrame_x, p%Vars%Nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return call AllocAry(InitOut%DerivOrder_x, p%Vars%Nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return InitOut%DerivOrder_x = 2 + InitOut%RotFrame_x = .false. do i = 1, size(p%Vars%x) do j = 1, p%Vars%x(i)%Num InitOut%LinNames_x(p%Vars%x(i)%iLoc) = p%Vars%x(i)%LinNames - InitOut%RotFrame_x(p%Vars%x(i)%iLoc) = iand(p%Vars%x(i)%Flags, VF_RotFrame) > 0 end do end do @@ -509,12 +541,84 @@ subroutine Init_ModuleVars(InitInp, u, p, y, m, InitOut, ErrStat, ErrMsg) end do contains + function OutputLinNames(Hdr, Unt) result(LinNames) + character(ChanLen), dimension(:), intent(in) :: Hdr, Unt + character(LinChanLen), dimension(:), allocatable :: LinNames + integer(IntKi) :: m + allocate(LinNames(size(Hdr))) + do m = 1, size(Hdr) + LinNames(m) = trim(Hdr(m))//', '//trim(Unt(m)) + end do + end function logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev end function Failed end subroutine + +subroutine SD_PackStateValues(p, x, ary) + type(SD_ParameterType), intent(in) :: p + type(SD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%jUsr) + case (1) + ary(p%Vars%x(i)%iLoc) = x%qm + case (2) + ary(p%Vars%x(i)%iLoc) = x%qmdot + end select + end do +end subroutine + +subroutine SD_UnpackStateValues(p, ary, x) + type(SD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(SD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(p%Vars%x) + select case(p%Vars%x(i)%jUsr) + case (1) + x%qm = ary(p%Vars%x(i)%iLoc) + case (2) + x%qmdot = ary(p%Vars%x(i)%iLoc) + end select + end do +end subroutine + +subroutine SD_PackInputValues(p, u, ary) + type(SD_ParameterType), intent(in) :: p + type(SD_InputType), intent(in) :: u + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + call MV_PackMesh(p%Vars%u, iv, u%TPMesh, ary) + call MV_PackMesh(p%Vars%u, iv, u%LMesh, ary) +end subroutine + +subroutine SD_UnpackInputValues(p, ary, u) + type(SD_ParameterType), intent(in) :: p + real(R8Ki), intent(in) :: ary(:) + type(SD_InputType), intent(inout) :: u + integer(IntKi) :: iv, i + iv = 1 + call MV_UnpackMesh(p%Vars%u, iv, ary, u%TPMesh) + call MV_UnpackMesh(p%Vars%u, iv, ary, u%LMesh) +end subroutine + +subroutine SD_PackOutputValues(p, y, ary) + type(SD_ParameterType), intent(in) :: p + type(SD_OutputType), intent(in) :: y + real(R8Ki), intent(out) :: ary(:) + integer(IntKi) :: iv, i + iv = 1 + call MV_PackMesh(p%Vars%y, iv, y%Y1Mesh, ary) + call MV_PackMesh(p%Vars%y, iv, y%Y2Mesh, ary) + call MV_PackMesh(p%Vars%y, iv, y%Y3Mesh, ary) + call MV_PackVar(p%Vars%y, iv, y%WriteOutput, ary) +end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. !! Continuous, discrete, constraint, and other states are updated for t + Interval. @@ -2028,7 +2132,7 @@ END SUBROUTINE SD_AM2 !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, IsSolve, dYdu, dXdu, dXddu, dZdu) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2040,107 +2144,143 @@ SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] ! local variables - TYPE(SD_OutputType) :: y_m, y_p - TYPE(SD_ContinuousStateType) :: x_m, x_p + TYPE(SD_OutputType) :: y_p + TYPE(SD_ContinuousStateType) :: x_p TYPE(SD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i + LOGICAL :: IsSolveLoc + INTEGER(IntKi) :: i, j, k integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_JacobianPInput' + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + if (present(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if + ! get OP values here: call SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return + ! make a copy of the inputs to perturb call SD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + + ! Pack operating point input values for perturbations + call SD_PackInputValues(p, u, m%Vals%u) + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + IF (PRESENT(dYdu)) THEN + + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%Vars%Ny, p%Vars%Nu, 'dYdu', ErrStat2, ErrMsg2); if(Failed()) return end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta_m u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + + ! Loop through input variables + do i = 1, size(p%Vars%u) + + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call SD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call SD_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputValues(p, y_p, m%Vals%yp) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call SD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call SD_CalcOutput(t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputValues(p, y_p, m%Vals%yn) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%u(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdu(:,k)) + end do end do - if(Failed()) return - END IF - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! TODO: dXdu should be constant, in theory we dont' need to recompute it + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + ! TODO: dXdu should be constant, in theory we dont' need to recompute it + IF (PRESENT(dXdu)) THEN + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, p%Vars%Nx, p%Vars%Nu, 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + endif + !if(ANALYTICAL_LIN) then ! Analytical lin cannot be used anymore with extra mom ! call StateMatrices(p, ErrStat2, ErrMsg2, BB=dXdu); if(Failed()) return ! Allocation occurs in function - !else - if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - endif - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute x at u_op + delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute x at u_op - delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + + ! Loop through input variables + do i = 1,size(p%Vars%u) + + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%u(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%u(i)%Solve))) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%u(i)%Num + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, 1, m%Vals%u, m%Vals%u_perturb, k) + call SD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call SD_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackStateValues(p, x_p, m%Vals%xp) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%u(i), j, -1, m%Vals%u, m%Vals%u_perturb, k) + call SD_UnpackInputValues(p, m%Vals%u_perturb, u_perturb) + call SD_CalcContStateDeriv(t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackStateValues(p, x_p, m%Vals%xn) + + ! Get partial derivative via central difference + dXdu(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki*p%Vars%u(i)%Perturb) end do - !endif ! analytical or numerical - END IF ! dXdu + end do + end if + IF ( PRESENT( dXddu ) ) THEN if (allocated(dXddu)) deallocate(dXddu) END IF + IF ( PRESENT( dZdu ) ) THEN if (allocated(dZdu)) deallocate(dZdu) END IF + call CleanUp() contains logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() end function Failed subroutine CleanUp() - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) + call SD_DestroyContState(x_p, ErrStat2, ErrMsg2) + call SD_DestroyOutput(y_p, ErrStat2, ErrMsg2) + call SD_DestroyInput(u_perturb, ErrStat2, ErrMsg2) end subroutine cleanup END SUBROUTINE SD_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) +SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, IsSolve, dYdx, dXdx, dXddx, dZdx) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2152,104 +2292,134 @@ SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] ! local variables - TYPE(SD_OutputType) :: y_p, y_m - TYPE(SD_ContinuousStateType) :: x_p, x_m + TYPE(SD_OutputType) :: y_p + TYPE(SD_ContinuousStateType) :: x_p TYPE(SD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: idx + INTEGER(IntKi) :: i, j, k + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_JacobianPContState' + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' + + ! Pack operating point state values for perturbations + call SD_PackStateValues(p, x, m%Vals%x) + ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY - call SD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + call SD_CopyContState(x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (present(dYdx)) then + + ! Allocate dYdx if not allocated if (.not. allocated(dYdx)) then call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - idx = 1 - do k=1,2 ! 1=disp, 2=veloc - do i=1,p%Jac_nx ! CB mode - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute y at x_op + delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute y at x_op - delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta, dYdx(:,idx) ) - idx = idx+1 + call SD_CopyOutput(y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%Num + + ! Calculate positive perturbation + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call SD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call SD_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputValues(p, y_p, m%Vals%yp) + + ! Calculate negative perturbation + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call SD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call SD_CalcOutput(t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackOutputValues(p, y_p, m%Vals%yn) + + ! Get partial derivative via central difference + call MV_ComputeCentralDiff(p%Vars%y, p%Vars%x(i)%Perturb, m%Vals%yp, m%Vals%yn, dYdx(:,k)) end do end do - if(Failed()) return - END IF - IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! TODO: dXdx should be constant, in theory we don't need to recompute it - if(ANALYTICAL_LIN) then - call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return ! Allocation occurs in function + end if + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! TODO: dXdx should be constant, in theory we don't need to recompute it + if (present(dXdx)) then + + ! If analytical linearization is enabled + if (ANALYTICAL_LIN) then + + ! Calculate dXdx as state matrix, allocation occurs in function + call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return else + + ! Allocate dXdx if not allocated if (.not. allocated(dXdx)) then call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=1,p%Jac_nx - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute x at x_op - delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta, dXdx(:,idx) ) - idx = idx+1 + + ! Loop through state variables + do i = 1,size(p%Vars%x) + + ! If extended linearization variable or solver call and variable not marked for solve, skip + if ((iand(p%Vars%x(i)%Flags, VF_Ext) > 0) .or. (IsSolveLoc .and. (.not. p%Vars%x(i)%Solve))) cycle + + ! Loop through number of linearization perturbations in variable + do j = 1,p%Vars%x(i)%Num + + ! Calculate positive perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%x(i), j, 1, m%Vals%x, m%Vals%x_perturb, k) + call SD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call SD_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackStateValues(p, x_p, m%Vals%xp) + + ! Calculate negative perturbation and resulting continuous state derivatives + call MV_Perturb(p%Vars%x(i), j, -1, m%Vals%x, m%Vals%x_perturb, k) + call SD_UnpackStateValues(p, m%Vals%x_perturb, x_perturb) + call SD_CalcContStateDeriv(t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2); if (Failed()) return + call SD_PackStateValues(p, x_p, m%Vals%xn) + + ! Get partial derivative via central difference + dXdx(:,k) = (m%Vals%xp - m%Vals%xn) / (2.0_R8Ki * p%Vars%x(i)%Perturb) end do end do endif ! analytical or numerical - END IF - IF ( PRESENT( dXddx ) ) THEN + end if + + if ( present( dXddx ) ) then if (allocated(dXddx)) deallocate(dXddx) - END IF - IF ( PRESENT( dZdx ) ) THEN + end if + + if ( present( dZdx ) ) then if (allocated(dZdx)) deallocate(dZdx) - END IF + end if + call CleanUp() contains logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_JacobianPContState') + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev if (Failed) call CleanUp() end function Failed subroutine CleanUp() call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call SD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup @@ -2344,95 +2514,56 @@ SUBROUTINE SD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, LOGICAL, OPTIONAL, INTENT(IN ) :: NeedTrimOP !< whether a y_op values should contain values for trim solution (3-value representation instead of full orientation matrices, no rotation acc) ! Local - INTEGER(IntKi) :: idx, i - LOGICAL :: ReturnTrimOP - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(SD_ContinuousStateType) :: dx ! derivative of continuous states at operating point + INTEGER(IntKi) :: idx, i + LOGICAL :: ReturnTrimOP + INTEGER(IntKi) :: nu + INTEGER(IntKi) :: ny + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' + LOGICAL :: FieldMask(FIELDMASK_SIZE) + TYPE(SD_ContinuousStateType) :: dx ! derivative of continuous states at operating point + ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) + u%TPMesh%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + + if (present(u_op)) then if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(u_op, p%Vars%Nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return end if - idx = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%TPMesh, u_op, idx, FieldMask=FieldMask) - call PackLoadMesh(u%LMesh, u_op, idx) - END IF + call SD_PackInputValues(p, u, u_op) + end if - IF ( PRESENT( y_op ) ) THEN - ny = p%Jac_ny + y%Y2Mesh%NNodes * 6 + y%Y3Mesh%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + if (present(y_op)) then if (.not. allocated(y_op)) then - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(y_op, p%Vars%Ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return end if - - if (present(NeedTrimOP)) then - ReturnTrimOP = NeedTrimOP - else - ReturnTrimOP = .false. - end if - - if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - - idx = 1 - call PackLoadMesh(y%Y1Mesh, y_op, idx) - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%Y2Mesh, y_op, idx, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%Y3Mesh, y_op, idx, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - idx = idx - 1 - do i=1,p%NumOuts - y_op(i+idx) = y%WriteOutput(i) - end do - END IF + call SD_PackOutputValues(p, y, y_op) + end if - IF ( PRESENT( x_op ) ) THEN + if (present(x_op)) then if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx*2,'x_op',ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(x_op, p%Vars%Nx,'x_op',ErrStat2, ErrMsg2); if (Failed()) return end if - do i=1, p%Jac_nx - x_op(i) = x%qm(i) - end do - do i=1, p%Jac_nx - x_op(i+p%nDOFM) = x%qmdot(i) - end do - END IF - IF ( PRESENT( dx_op ) ) THEN + call SD_PackStateValues(p, x, x_op) + end if + + if (present(dx_op)) then if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2); if(failed()) return + call AllocAry(dx_op, p%Vars%Nx, 'dx_op',ErrStat2, ErrMsg2); if(failed()) return end if - call SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return - idx = 1 - do i=1, p%Jac_nx - dx_op(i) = dx%qm(i) - end do - do i=1, p%Jac_nx - dx_op(i+p%nDOFM) = dx%qmdot(i) - end do - END IF - IF ( PRESENT( xd_op ) ) THEN + call SD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2); if(Failed()) return + call SD_PackStateValues(p, dx, dx_op) + end if + + if (present(xd_op)) then ! pass - END IF - IF ( PRESENT( z_op ) ) THEN + end if + + if (present(z_op)) then ! pass - END IF + end if + call CleanUp() contains logical function Failed() From 9faec51108593b9a43aadf0d64d55ed8b945d424 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 5 Oct 2023 19:56:10 +0000 Subject: [PATCH 58/61] Remove smart Jac update from Solver.f90 --- modules/openfast-library/src/Solver.f90 | 34 +++++-------------------- 1 file changed, 7 insertions(+), 27 deletions(-) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index d3680642c1..0a24d668ea 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -670,7 +670,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 integer(IntKi) :: i, j - logical :: ConvUJac ! Jacobian updated for convergence ErrStat = ErrID_None ErrMsg = '' @@ -689,9 +688,6 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 - ! Set Jacobian updated for convergence flag to false - ConvUJac = .false. - ! Init counters for number of Jacobian updates and number of convergence iterations NumUJac = 0 iterTotal = 0 @@ -828,29 +824,13 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! If convergence iteration has reached or exceeded limit if (iterConv >= p%MaxConvIter) then - ! If Jacobian has not been updated for convergence - if (.not. ConvUJac) then - - ! Set counter to trigger a Jacobian update on next convergence iteration - m%IterUntilUJac = 0 - - ! If at the maximum number of correction iterations, - ! increase limit to retry the step after the Jacobian is updated - if (iterCorr == NumCorrections) NumCorrections = NumCorrections + 1 - - ! Set flag indicating that the jacobian has been updated for convergence - ConvUJac = .true. - - else - - ! Otherwise, correction iteration with Jacobian update has been tried, - ! display warning that convergence failed and move to next step - call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & - " iterations on step "//trim(Num2LStr(n_t_global_next))// & - " (error="//trim(Num2LStr(delta_norm))// & - ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & - ErrStat, ErrMsg, RoutineName) - end if + ! Otherwise, correction iteration with Jacobian update has been tried, + ! display warning that convergence failed and move to next step + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations on step "//trim(Num2LStr(n_t_global_next))// & + " (error="//trim(Num2LStr(delta_norm))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ErrStat, ErrMsg, RoutineName) ! Exit convergence loop to next correction iteration or next step exit From ecd427477fdfa657fe96531626feba0cd3c613d4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 5 Oct 2023 19:58:21 +0000 Subject: [PATCH 59/61] Don't use fancy DDT init, ifort doesn't support --- modules/openfast-library/src/FAST_Eval.f90 | 73 ++++++++++++++-------- 1 file changed, 47 insertions(+), 26 deletions(-) diff --git a/modules/openfast-library/src/FAST_Eval.f90 b/modules/openfast-library/src/FAST_Eval.f90 index c9a1ae842d..0685164fed 100644 --- a/modules/openfast-library/src/FAST_Eval.f90 +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -862,7 +862,6 @@ subroutine LoadMeshMap(Mappings, Key, SrcMod, SrcMesh, SrcDispMesh, & character(*), parameter :: RoutineName = 'MotionMeshMap' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i1Loc, i2Loc type(TC_MappingType) :: Mapping ErrStat = ErrID_None @@ -888,16 +887,23 @@ subroutine LoadMeshMap(Mappings, Key, SrcMod, SrcMesh, SrcDispMesh, & return end if - ! Get optional mapping indicies - i1Loc = 0; if (present(i1)) i1Loc = i1 - i2Loc = 0; if (present(i2)) i2Loc = i2 - ! Initialize mapping structure - Mapping = TC_MappingType(Key=Key, Typ=Map_LoadMesh, i1=i1Loc, i2=i2Loc, & - SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, & - SrcMeshID=SrcMesh%ID, SrcDispMeshID=SrcDispMesh%ID, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, & - DstMeshID=DstMesh%ID, DstDispMeshID=DstDispMesh%ID) + Mapping%Key = Key + Mapping%Typ = Map_LoadMesh + Mapping%SrcModIdx = SrcMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%SrcMeshID = SrcMesh%ID + Mapping%SrcDispMeshID = SrcDispMesh%ID + Mapping%DstModIdx = DstMod%Idx + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + Mapping%DstMeshID = DstMesh%ID + Mapping%DstDispMeshID = DstDispMesh%ID + + ! Get optional mapping indicies + if (present(i1)) Mapping%i1 = i1 + if (present(i2)) Mapping%i2 = i2 ! Create mesh mapping call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return @@ -929,7 +935,6 @@ subroutine MotionMeshMap(Mappings, Key, SrcMod, SrcMesh, & character(*), parameter :: RoutineName = 'MotionMeshMap' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: i1Loc, i2Loc type(TC_MappingType) :: Mapping ErrStat = ErrID_None @@ -949,14 +954,21 @@ subroutine MotionMeshMap(Mappings, Key, SrcMod, SrcMesh, & return end if - ! Get optional mapping indicies - i1Loc = 0; if (present(i1)) i1Loc = i1 - i2Loc = 0; if (present(i2)) i2Loc = i2 - ! Initialize mapping structure - Mapping = TC_MappingType(Key=Key, Typ=Map_MotionMesh, i1=i1Loc, i2=i2Loc, & - SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, SrcMeshID=SrcMesh%ID, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins, DstMeshID=DstMesh%ID) + Mapping%Key = Key + Mapping%Typ = Map_MotionMesh + Mapping%SrcModIdx = SrcMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%SrcMeshID = SrcMesh%ID + Mapping%DstModIdx = DstMod%Idx + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + Mapping%DstMeshID = DstMesh%ID + + ! Get optional mapping indicies + if (present(i1)) Mapping%i1 = i1 + if (present(i2)) Mapping%i2 = i2 ! Create mesh mapping call MeshMapCreate(SrcMesh, DstMesh, Mapping%MeshMap, ErrStat2, ErrMsg2); if (Failed()) return @@ -977,17 +989,26 @@ subroutine NonMeshMap(Maps, Key, SrcMod, DstMod, i1, i2, Active) type(ModDataType), intent(in) :: SrcMod, DstMod integer(IntKi), optional, intent(in) :: i1, i2 logical, optional, intent(in) :: Active - integer(IntKi) :: i1Loc, i2Loc + type(TC_MappingType) :: Mapping if (present(Active)) then if (.not. Active) return end if - i1Loc = 0 - i2Loc = 0 - if (present(i1)) i1Loc = i1 - if (present(i2)) i2Loc = i2 - Maps = [Maps, TC_MappingType(Key=Key, Typ=Map_NonMesh, i1=i1Loc, i2=i2Loc, & - SrcModIdx=SrcMod%Idx, SrcModID=SrcMod%ID, SrcIns=SrcMod%Ins, & - DstModIdx=DstMod%Idx, DstModID=DstMod%ID, DstIns=DstMod%Ins)] + + ! Initialize mapping structure + Mapping%Key = Key + Mapping%Typ = Map_NonMesh + Mapping%SrcModIdx = SrcMod%Idx + Mapping%SrcModID = SrcMod%ID + Mapping%SrcIns = SrcMod%Ins + Mapping%DstModIdx = DstMod%Idx + Mapping%DstModID = DstMod%ID + Mapping%DstIns = DstMod%Ins + + ! Get optional mapping indicies + if (present(i1)) Mapping%i1 = i1 + if (present(i2)) Mapping%i2 = i2 + + Maps = [Maps, Mapping] end subroutine subroutine FAST_InputSolve(ModData, Maps, Dst, T, ErrStat, ErrMsg) From c5b79607182eecdcfc93b5c811ec235e57a79ab0 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 1 Dec 2023 19:47:11 +0000 Subject: [PATCH 60/61] Enable smart Jacobian update logic --- modules/openfast-library/src/Solver.f90 | 34 ++++++++++++++++++++----- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/modules/openfast-library/src/Solver.f90 b/modules/openfast-library/src/Solver.f90 index 0a24d668ea..d3680642c1 100644 --- a/modules/openfast-library/src/Solver.f90 +++ b/modules/openfast-library/src/Solver.f90 @@ -670,6 +670,7 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM real(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) integer(IntKi) :: n_t_global_next ! n_t_global + 1 integer(IntKi) :: i, j + logical :: ConvUJac ! Jacobian updated for convergence ErrStat = ErrID_None ErrMsg = '' @@ -688,6 +689,9 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! Decrement number of time steps before updating the Jacobian m%StepsUntilUJac = m%StepsUntilUJac - 1 + ! Set Jacobian updated for convergence flag to false + ConvUJac = .false. + ! Init counters for number of Jacobian updates and number of convergence iterations NumUJac = 0 iterTotal = 0 @@ -824,13 +828,29 @@ subroutine Solver_Step(n_t_global, t_initial, p, m, Mods, Turbine, ErrStat, ErrM ! If convergence iteration has reached or exceeded limit if (iterConv >= p%MaxConvIter) then - ! Otherwise, correction iteration with Jacobian update has been tried, - ! display warning that convergence failed and move to next step - call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & - " iterations on step "//trim(Num2LStr(n_t_global_next))// & - " (error="//trim(Num2LStr(delta_norm))// & - ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & - ErrStat, ErrMsg, RoutineName) + ! If Jacobian has not been updated for convergence + if (.not. ConvUJac) then + + ! Set counter to trigger a Jacobian update on next convergence iteration + m%IterUntilUJac = 0 + + ! If at the maximum number of correction iterations, + ! increase limit to retry the step after the Jacobian is updated + if (iterCorr == NumCorrections) NumCorrections = NumCorrections + 1 + + ! Set flag indicating that the jacobian has been updated for convergence + ConvUJac = .true. + + else + + ! Otherwise, correction iteration with Jacobian update has been tried, + ! display warning that convergence failed and move to next step + call SetErrStat(ErrID_Warn, "Failed to converge in "//trim(Num2LStr(p%MaxConvIter))// & + " iterations on step "//trim(Num2LStr(n_t_global_next))// & + " (error="//trim(Num2LStr(delta_norm))// & + ", tolerance="//trim(Num2LStr(p%ConvTol))//").", & + ErrStat, ErrMsg, RoutineName) + end if ! Exit convergence loop to next correction iteration or next step exit From 239c437368acf04ffed80a06cd37cf715e64bdb2 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 22 Jan 2024 14:14:55 -0700 Subject: [PATCH 61/61] Make MaxOutPts public from InflowWind_Subs --- modules/inflowwind/src/InflowWind_Subs.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/inflowwind/src/InflowWind_Subs.f90 b/modules/inflowwind/src/InflowWind_Subs.f90 index 4dd9e2a86a..5156077a87 100644 --- a/modules/inflowwind/src/InflowWind_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Subs.f90 @@ -29,7 +29,7 @@ MODULE InflowWind_Subs PUBLIC :: CalculateOutput, InflowWind_GetRotorSpatialAverage, InflowWind_GetHubValues, & InflowWind_CloseSumFile, InflowWind_ParseInputFileInfo, SetAllOuts, & - InflowWind_OpenSumFile, InflowWind_SetParameters, InflowWind_ValidateInput + InflowWind_OpenSumFile, InflowWind_SetParameters, InflowWind_ValidateInput, MaxOutPts ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m"