diff --git a/CMakeLists.txt b/CMakeLists.txt index 5b14d3dd8d..b45ef3df1f 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" 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) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index ff5d6a1e86..ca6b68bd06 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -513,7 +513,13 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (Failed()) return; enddo end if - + + !............................................................................................ + ! Initialize Module Variables: + !............................................................................................ + + call Init_ModuleVars(InitInp, u, p, y, m, InitOut, errStat2, errMsg2); if (Failed()) return + !............................................................................................ ! Print the summary file if requested: !............................................................................................ @@ -602,6 +608,202 @@ 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(INOUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters + 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 + 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", & + Mesh=ru%TowerMotion, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel]) + + ! Add nacelle motion + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"NacelleMotion", & + Mesh=ru%NacelleMotion, & + Fields=[VF_TransDisp, VF_Orientation, VF_TransVel]) + + ! Add hub motion + call MV_AddMeshVar(p%Vars%u, trim(RotorStr)//"HubMotion", & + 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), & + 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), & + Mesh=ru%BladeMotion(j), & + 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, Mesh=ry%TowerLoad) + + ! Add nacelle load + 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, Mesh=ry%NacelleLoad) + + ! Loop through blades, add blade loads + do j = 1, rp%NumBlades + call MV_AddMeshVar(p%Vars%y, trim(RotorStr)//"BladeLoad"//IdxStr(j), LoadFields, Mesh=ry%BladeLoad(j)) + 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/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/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index d2354776ef..e4dfa31c23 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -50,7 +50,14 @@ MODULE BeamDyn ! states(z) PUBLIC :: BD_GetOP !< Routine to pack the operating point values (for linearization) into arrays + 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. CONTAINS @@ -109,48 +116,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,65 +143,28 @@ 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%rrN0, p%E10 + ! 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 - 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) @@ -227,41 +174,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 ) + call Init_u(InitInp, p, OtherState, u, ErrStat2, ErrMsg2); if (Failed()) return - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if + ! 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, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - ! allocate and initialize other states: - call Init_OtherStates(p, OtherState, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Init_ContinuousStates(p, u, x, 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 @@ -271,8 +196,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 @@ -294,7 +218,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, x, OtherState, MiscVar, y) IF(QuasiStaticInitialized) THEN ! Set the BldMotion mesh acceleration but only if quasistatic succeeded @@ -307,16 +231,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 !............................................... @@ -328,24 +250,311 @@ 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 ) - 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) + TYPE(BD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + 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(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 + 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, idx + 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, & + 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 + 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, & + 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, & + 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 + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + 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), & + iUsr=i, & + 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, 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 + + !---------------------------------------------------------------------------- + ! 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)%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 + + 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 + +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) @@ -666,8 +875,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 @@ -804,11 +1017,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 @@ -898,12 +1111,66 @@ 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 +!! 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 + 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 + 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 + GlbPos = u%RootMotion%Position(:, 1) + & + u%RootMotion%TranslationDisp(:, 1) + GlbRot = transpose(u%RootMotion%Orientation(:, :, 1)) + CALL BD_CrvExtractCrv(GlbRot, Glb_crv, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL BD_CrvMatrixR(Glb_crv, GlbRot) +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 @@ -916,6 +1183,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 @@ -923,20 +1191,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) + ! Gravity vector -- inertial frame! This must be multiplied by OtherState%GlbRot to get into the BD rotating reference frame + p%gravity = InitInp%gravity !.................... @@ -957,7 +1213,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 @@ -997,7 +1252,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 @@ -1019,7 +1292,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 ) @@ -1173,9 +1446,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 @@ -1243,10 +1517,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 @@ -1321,10 +1595,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 @@ -1402,8 +1677,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 & @@ -1449,11 +1724,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 & @@ -1506,11 +1781,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 & @@ -1525,8 +1800,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 & @@ -1536,8 +1811,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 & @@ -1755,9 +2030,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 @@ -1788,13 +2064,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 -- 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 !----------------------------------------------------------------------------------------------------------------------------------- !> 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 @@ -1829,11 +2109,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() @@ -1919,17 +2199,22 @@ 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 BD_GA2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + 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,'') 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 END SUBROUTINE BD_UpdateStates @@ -2024,14 +2309,15 @@ 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) + 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 x_tmp%dqdt(1:3,1) = m%u%RootMotion%TranslationVel(:,1) @@ -2047,27 +2333,27 @@ 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 ! Calculate internal forces and moments - CALL BD_InternalForceMoment( x, p, m ) + CALL BD_InternalForceMoment( x_tmp, OtherState, 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, m, y) + CALL Set_BldMotion_Mesh( p, m%u2, x_tmp, OtherState, m, y) !------------------------------------------------------- ! compute RootMxr and RootMyr for ServoDyn and @@ -2094,7 +2380,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 @@ -2131,6 +2417,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 @@ -2149,7 +2437,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 ) @@ -2159,11 +2447,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 ) - 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) + ! 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 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) @@ -2175,7 +2465,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 @@ -2183,7 +2473,7 @@ SUBROUTINE BD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta ! 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) @@ -2243,72 +2533,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 - - CHARACTER(*), PARAMETER :: RoutineName = 'BD_QuadraturePointDataAt0' - + INTEGER(IntKi) :: i + REAL(BDKi) :: twist, tan_vect(3), R0(3), u0(3) - ! 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 @@ -2357,48 +2632,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 @@ -3213,10 +3483,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' @@ -3226,7 +3497,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 @@ -3394,7 +3665,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 @@ -3422,7 +3693,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 @@ -3864,7 +4135,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) @@ -4117,7 +4388,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) @@ -4128,10 +4399,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 @@ -4142,7 +4414,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] @@ -4194,9 +4466,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 @@ -4308,8 +4581,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 @@ -4422,7 +4695,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 ) @@ -4436,7 +4709,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() @@ -4484,7 +4757,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 ) @@ -4605,21 +4878,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 + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'BD_BoundaryGA2' ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" + ! NOTE: u is in a BD local frame. So cannot use SetRefFrame routine (note there are differences here) + ! Root displacements - x%q(1:3,1) = u%RootMotion%TranslationDisp(1:3,1) + 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, x%q(4:6,1), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + 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) @@ -4937,7 +5213,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) @@ -4953,9 +5229,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? @@ -4980,7 +5257,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) ) @@ -5149,32 +5426,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 @@ -5228,11 +5506,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 @@ -5253,7 +5532,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 @@ -5265,10 +5544,10 @@ 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) + 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 @@ -5415,11 +5694,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 @@ -5443,7 +5723,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 @@ -5527,10 +5807,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 @@ -5557,7 +5838,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 @@ -5781,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, StateRel_x, StateRel_xdot) +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 @@ -5806,226 +6087,116 @@ 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 - + LOGICAL, OPTIONAL, INTENT(IN) :: IsSolve !< Flag indicating this is called from the solver, skip non-solver variables - ! 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) + LOGICAL :: IsSolveLoc - 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 = '' - + 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 ) - 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 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 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 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 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 + 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, :) ) @@ -6045,19 +6216,18 @@ 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 !! 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 @@ -6087,17 +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 - 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) + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6105,67 +6271,51 @@ 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) - - if (p%RotStates) then + 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, IsSolveLoc); if (Failed()) return + + ! 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 ) 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 - else - if ( present(StateRotation) ) then - if (allocated(StateRotation)) deallocate(StateRotation) - end if - end if - - IF ( PRESENT( dYdx ) ) 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 + + else if ( present(StateRotation) ) then + if (allocated(StateRotation)) deallocate(StateRotation) + end if + IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) @@ -6175,23 +6325,17 @@ 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 !! 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 @@ -6215,18 +6359,17 @@ 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 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 + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6238,155 +6381,108 @@ 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) + ! 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 + 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_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 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 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 - ! 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)%Num + + ! 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) ) + ! Loop through state variables + do i = 1,size(p%Vars%x) - index = index+1 - end do + ! 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 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 +6647,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 +6715,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 +6820,94 @@ 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 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 + 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, temp_id + + 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 + GlbWM_old = OtherState%Glb_crv + + ! Calculate new global position, rotation, and WM from root motion (updates otherstate reference frame info) + 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 + OtherState%GlbPos = GlbPos_new + OtherState%GlbRot = GlbRot_new + OtherState%Glb_crv = GlbWM_new + + ! Calculate differences between old and new reference + 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 + + ! 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 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 + + ! 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 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 + 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 !----------------------------------------------------------------------------------------------------------------------------------- END MODULE BeamDyn 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 af3548c49e..0f242f6e2e 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) @@ -1915,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 @@ -1947,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 @@ -2529,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(:,:) !< @@ -2564,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 e60ab59dab..61ae592b1a 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -623,10 +623,11 @@ 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, x, OtherState, m, y) 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(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) @@ -655,14 +656,17 @@ 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) = 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 ! 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) @@ -672,24 +676,25 @@ SUBROUTINE Set_BldMotion_NoAcc(p, 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 CASE (BD_MESH_QP) - + 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 ! 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) = OtherState%GlbPos + matmul(OtherState%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 @@ -697,7 +702,7 @@ SUBROUTINE Set_BldMotion_NoAcc(p, 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, 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 ) + CALL BD_CrvCompose( cc0, OtherState%Glb_crv, cc, FLAG_R1R2 ) 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) @@ -705,29 +710,27 @@ SUBROUTINE Set_BldMotion_NoAcc(p, 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,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 - - CASE (BD_MESH_STATIONS) END SELECT - 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) @@ -741,7 +744,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, x, OtherState, m, y) ! Only need this bit for dynamic cases IF ( p%analysis_type /= BD_STATIC_ANALYSIS ) THEN @@ -762,9 +765,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 @@ -790,9 +793,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 @@ -835,9 +838,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 @@ -853,9 +856,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 @@ -1067,7 +1070,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 @@ -1096,9 +1099,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 @@ -1118,7 +1122,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) @@ -1126,7 +1130,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 @@ -1134,9 +1138,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) @@ -1148,7 +1153,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 226c4a5137..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 [-] @@ -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] [-] @@ -147,6 +147,9 @@ MODULE BeamDyn_Types 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) [-] + 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 ======= @@ -157,13 +160,15 @@ 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 [-] - 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] + 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 = 0.0_R8Ki !< Blade Length [-] @@ -172,16 +177,12 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN = 0.0_R8Ki !< Blade Length [-] REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] REAL(R8Ki) :: tol = 0.0_R8Ki !< Tolerance used in stopping criterion [-] - REAL(R8Ki) , DIMENSION(1:3) :: GlbPos = 0.0_R8Ki !< Initial Position Vector between origins of Global and blade frames (BD coordinates) [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial Rotation Tensor between Global and Blade frames (BD coordinates; transfers local to global) [-] - REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv = 0.0_R8Ki !< CRV parameters of GlbRot [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtN !< Quadrature (QuadPt) point locations in natural frame [-1, 1] [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtWeight !< Weights at each quadrature point (QuadPt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Shp !< Shape function matrix (index 1 = FE nodes; index 2=quadrature points) [-] 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 [-] @@ -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 @@ -457,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) @@ -585,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 @@ -618,6 +621,7 @@ 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 @@ -630,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)) @@ -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) @@ -716,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 @@ -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) @@ -1575,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) @@ -1609,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 @@ -1652,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) @@ -1775,6 +1816,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 @@ -1790,6 +1843,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) @@ -1845,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) @@ -1920,18 +1982,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) @@ -2172,7 +2222,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,9 +2235,18 @@ 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 + if (allocated(ParamData%twN0)) then + deallocate(ParamData%twN0) + end if if (allocated(ParamData%Stif0_QP)) then deallocate(ParamData%Stif0_QP) end if @@ -2219,9 +2277,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 @@ -2292,7 +2347,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) @@ -2301,6 +2364,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)) @@ -2328,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)) @@ -2361,11 +2426,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)) @@ -2492,7 +2552,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 +2563,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) @@ -2525,6 +2606,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 @@ -2595,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 @@ -2685,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 @@ -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/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..d390f4fc3b 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) @@ -640,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 @@ -680,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/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 419d06517d..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" - @@ -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]" - @@ -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 @@ -162,15 +166,17 @@ 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" #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 +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" - @@ -179,16 +185,12 @@ 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)" - 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 #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -248,7 +250,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 +374,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" 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_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_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 a2b9fe2f19..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) @@ -131,10 +132,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) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 2bcfb11fc4..e6ea1b341b 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -63,8 +63,15 @@ 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 + + PUBLIC :: ED_UpdateAzimuth CONTAINS + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. @@ -95,12 +102,11 @@ 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 ! Initialize variables for this routine @@ -286,11 +292,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 +306,16 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut Interval = p%DT + !............................................................................................ + ! 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 @@ -352,6 +368,450 @@ SUBROUTINE CheckError(ErrID,Msg) 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(INOUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< Parameters + 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 + 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 + !---------------------------------------------------------------------------- + + allocate(p%Vars%x(0)) + + ! 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(1), 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, "BladeLoad"//IdxStr(i), LoadFields, & + Mesh=u%BladePtLoads(i), & + 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, "PlatformLoad", LoadFields, & + Mesh=u%PlatformPtMesh, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Tower point loads + call MV_AddMeshVar(p%Vars%u, "TowerLoad", LoadFields, & + 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, & + Mesh=u%HubPtLoad, & + Perturbs=[MaxThrust / 100.0_R8Ki, & + MaxTorque / 100.0_R8Ki]) + ! Nacelle point loads + call MV_AddMeshVar(p%Vars%u, "NacelleLoad", LoadFields, & + Mesh=u%NacelleLoads, & + 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) + + ! 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 + !---------------------------------------------------------------------------- + + if (allocated(y%BladeLn2Mesh))then + do i = 1, p%NumBl + 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, 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, Mesh=y%BladeRootMotion(i)) + end do + 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']) + 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 + 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 + + !---------------------------------------------------------------------------- + ! 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 + if (ErrStat >= AbortErrLev) 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 + 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 + 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 + 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 + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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 ) @@ -474,6 +934,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. @@ -1852,10 +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) - - RETURN - - END SUBROUTINE ED_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states. @@ -1977,8 +2447,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) - + !OtherState%SgnPrvLSTQ = SignLSSTrq(p, m) END SUBROUTINE ED_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- @@ -10170,7 +10639,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 @@ -10195,205 +10664,141 @@ 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_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 + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_JacobianPInput' - - - ! Initialize ErrStat 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) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - + ! 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 + call ED_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 necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+1, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + 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) - 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) - 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 - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - + ! 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 - END IF - + ! Loop through input variables + do i = 1, size(p%Vars%u) - IF ( PRESENT( dXdu ) ) THEN + ! 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 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); 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); 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)) + 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) + end if + ! 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%DOFs%NActvDOF * 2, size(p%Jac_u_indx,1)+1, 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + 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 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 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 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); 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); if (Failed()) return + call ED_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 - 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 - - - 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 + ! 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) + 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() 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 - + 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 !! 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 @@ -10418,15 +10823,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_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 + LOGICAL :: IsSolveLoc INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10439,132 +10843,90 @@ 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 - ! 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(IsSolve)) then + IsSolveLoc = IsSolve + else + IsSolveLoc = .false. + end if - IF ( PRESENT( dYdx ) ) THEN + ! Pack operating point state values for perturbations + call ED_PackStateValues(p, x, m%Vals%x) - ! 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 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%Jac_ny, p%DOFs%NActvDOF*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 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) ) + ! 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 + ! 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 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); 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); 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 - - 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 + 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%DOFs%NActvDOF * 2, p%DOFs%NActvDOF * 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 - - 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 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 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); 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); if (Failed()) return + call ED_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 - 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 + end if IF ( PRESENT( dXddx ) ) THEN if (allocated(dXddx)) deallocate(dXddx) @@ -10579,13 +10941,15 @@ 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 - + 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 @@ -10732,608 +11096,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 +11111,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 +11138,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 +11159,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 +11174,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 +11187,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 +11199,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) @@ -11531,6 +11216,5 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, END SUBROUTINE ED_GetOP !---------------------------------------------------------------------------------------------------------------------------------- - END MODULE ElastoDyn !********************************************************************************************************************************** diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index d18ab670cd..03f99e89a5 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -55,6 +55,7 @@ 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" # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -521,10 +522,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 +747,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..d74095cdd6 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -75,6 +75,7 @@ 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 [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= @@ -530,10 +531,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) :: Vals !< Values corresponding to module variables [-] 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 +751,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 +1067,7 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if + DstInitOutputData%Vars => SrcInitOutputData%Vars end subroutine subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1118,12 +1120,14 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%IsLoad_u)) then deallocate(InitOutputData%IsLoad_u) end if + nullify(InitOutputData%Vars) 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 +1208,13 @@ 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 if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1214,6 +1225,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 +1437,26 @@ 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 end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -7550,6 +7583,9 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%QD2T = SrcMiscData%QD2T end if DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod + 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) @@ -7586,6 +7622,8 @@ subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%QD2T)) then deallocate(MiscData%QD2T) end if + call NWTC_Library_DestroyModValsType(MiscData%Vals, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ED_PackMisc(Buf, Indata) @@ -7631,6 +7669,7 @@ subroutine ED_PackMisc(Buf, Indata) call RegPack(Buf, InData%QD2T) end if call RegPack(Buf, InData%IgnoreMod) + call NWTC_Library_PackModValsType(Buf, InData%Vals) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7744,6 +7783,7 @@ subroutine ED_UnPackMisc(Buf, OutData) end if call RegUnpack(Buf, OutData%IgnoreMod) if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackModValsType(Buf, OutData%Vals) ! Vals end subroutine subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -7759,6 +7799,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 +8640,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 +8655,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 +8840,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 +8848,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 +9299,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 +9312,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 +10424,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) + call RegUnpack(Buf, OutData%iBlPitchCoModVarType) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_ny) + call RegUnpack(Buf, OutData%iBlPitchComCVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine 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/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..5156077a87 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, MaxOutPts ! =================================================================================================== ! 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) diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 81a39fc2a0..994765fd44 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 Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt + set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS + src/Registry_NWTC_Library_mesh.txt + src/Registry_NWTC_Library_base.txt) # if these files change, rerun configure + file(READ src/Registry_NWTC_Library_base.txt BASE_CONTENTS) + file(READ src/Registry_NWTC_Library_mesh.txt MESH_CONTENTS) + file(WRITE src/Registry_NWTC_Library.txt "${BASE_CONTENTS}\n${MESH_CONTENTS}") + generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) endif() #------------------------------------------------------------------------------- @@ -60,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/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 new file mode 100644 index 0000000000..f6c7db7fc0 --- /dev/null +++ b/modules/nwtc-library/src/ModVar.f90 @@ -0,0 +1,984 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2023 National Renewable Energy Laboratory +! +! This file is part of the NWTC Subroutine Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> The modules ModVar and ModVar_Types provide data structures and subroutines for representing and manipulating meshes +!! and meshed data in the FAST modular framework. +!! +!! Module variables provide a structured way for documenting, locating, and orchestrating the interdependencies between modules. +!! + +module ModVar +use NWTC_Library_Types +use NWTC_IO +use ModMesh +implicit none + +private + +integer(IntKi), parameter :: & + LoadFields(*) = [VF_Force, VF_Moment], & + TransFields(*) = [VF_TransDisp, VF_TransVel, VF_TransAcc], & + AngularFields(*) = [VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & + MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & + MeshFields(*) = [LoadFields, MotionFields] + +interface MV_PackVar + module procedure MV_PackVarR4, MV_PackVarR4Ary + module procedure MV_PackVarR8, MV_PackVarR8Ary +end interface + +interface MV_UnpackVar + module procedure MV_UnpackVarR4, MV_UnpackVarR4Ary + module procedure MV_UnpackVarR8, MV_UnpackVarR8Ary +end interface + +public :: MV_InitVarsVals, MV_LinkOutputInput, MV_VarIndex, MV_PackMesh, MV_UnpackMesh, MV_PackVar, MV_UnpackVar +public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff +public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags +public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields +public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_xyz, wm_from_xyz +public :: MV_FieldString, IdxStr + +contains + +function MV_FieldString(Field) result(str) + integer(IntKi), intent(in) :: Field + character(16) :: str + select case (Field) + case (VF_AngularAcc) + str = "VF_AngularAcc" + case (VF_AngularDisp) + str = "VF_AngularDisp" + case (VF_AngularVel) + str = "VF_AngularVel" + case (VF_Force) + str = "VF_Force" + case (VF_Moment) + str = "VF_Moment" + case (VF_Orientation) + str = "VF_Orientation" + case (VF_TransAcc) + str = "VF_TransAcc" + case (VF_TransDisp) + str = "VF_TransDisp" + case (VF_TransVel) + str = "VF_TransVel" + case default + str = "Unknown" + end select +end function + +subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: Vars + type(ModValsType), intent(inout) :: Vals + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_InitMod' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, StartIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize state variables + if (.not. allocated(Vars%x)) allocate (Vars%x(0)) + StartIndex = 1 + do i = 1, size(Vars%x) + call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Initialize input variables + if (.not. allocated(Vars%u)) allocate (Vars%u(0)) + StartIndex = 1 + do i = 1, size(Vars%u) + call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Initialize output variables + if (.not. allocated(Vars%y)) allocate (Vars%y(0)) + StartIndex = 1 + do i = 1, size(Vars%y) + call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Calculate number of state, input, and output variables + Vars%Nx = sum(Vars%x%Num) + Vars%Nu = sum(Vars%u%Num) + Vars%Ny = sum(Vars%y%Num) + + ! Allocate state, input, and output values + call AllocAry(Vals%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%dxdt, Vars%Nx, "Vals%dxdt", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%u, Vars%Nu, "Vals%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%y, Vars%Ny, "Vals%y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate perturbation input and output values + call AllocAry(Vals%u_perturb, Vars%Nu, "Vals%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%x_perturb, Vars%Nx, "Vals%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%xp, Vars%Nx, "Vals%xp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%xn, Vars%Nx, "Vals%xn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%yp, Vars%Ny, "Vals%yp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%yn, Vars%Ny, "Vals%yn", ErrStat2, ErrMsg2); if (Failed()) return + +contains + + function Failed() + logical Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + function FailedAlloc() + logical FailedAlloc + FailedAlloc = ErrStat2 /= 0 + if (FailedAlloc) call SetErrStat(ErrID_Fatal, 'error allocating Vals', ErrStat, ErrMsg, RoutineName) + end function + +end subroutine + +elemental function IsMesh(Var) result(r) + type(ModVarType), intent(in) :: Var + logical :: r + r = iand(Var%Flags, VF_Mesh) > 0 +end function + +subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(inout) :: Index + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModVarsType_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + integer(IntKi) :: nNodes + character(1), parameter :: Comp(3) = ['X', 'Y', 'Z'] + character(*), parameter :: Fmt = '(A," ",A,", node",I0,", ",A)' + character(2) :: UnitDesc + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Mesh + !---------------------------------------------------------------------------- + + ! If this variable belongs to a mesh + if (iand(Var%Flags, VF_Mesh) > 0) then + + ! Size is the number of nodes in a mesh + Var%Nodes = Var%Num + + ! Number of values + Var%Num = Var%Nodes*3 + + ! If linearization requested + if (Linearize) then + + ! Set unit description for line mesh + UnitDesc = '' + if (iand(Var%Flags, VF_Line) > 0) UnitDesc = "/m" + + ! Switch based on field number + select case (Var%Field) + case (VF_Force) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_Moment) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_TransDisp) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, nNodes)] + case (VF_Orientation) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, nNodes)] + case (VF_TransVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, nNodes)] + case (VF_AngularVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, nNodes)] + case (VF_TransAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, nNodes)] + case (VF_AngularAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, nNodes)] + case default + call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) + return + end select + + end if + end if + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + if (Linearize) then + + ! If incorrect number of linearization names, return error + if (size(Var%LinNames) < Var%Num) then + call SetErrStat(ErrID_Fatal, "insufficient LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + else if (size(Var%LinNames) > Var%Num) then + call SetErrStat(ErrID_Fatal, "excessive LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Indices + !---------------------------------------------------------------------------- + + ! Initialize local index + call AllocAry(Var%iLoc, Var%Num, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return + Var%iLoc = [(index + i, i=0, Var%Num - 1)] + + ! Update index based on variable size + index = index + Var%Num + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!------------------------------------------------------------------------------- +! Functions for packing and unpacking data by variable +!------------------------------------------------------------------------------- + +subroutine MV_PackVarR4(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc(1)) = real(Val, R8Ki) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR8(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc(1)) = Val + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR4Ary(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Val(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc) = real(pack(Val, .true.), R4Ki) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR8Ary(VarAry, iVar, Vals, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Vals(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc) = pack(Vals, .true.) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Val + Val = Ary(VarAry(iVar)%iLoc(1)) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR4Ary(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals = Ary(VarAry(iVar)%iLoc) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR8(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals + Vals = Ary(VarAry(iVar)%iLoc(1)) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR8Ary(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals = Ary(VarAry(iVar)%iLoc) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + type(MeshType), intent(in) :: Mesh + real(R8Ki), intent(inout) :: Values(:) + integer(IntKi) :: MeshID, j + MeshID = VarAry(iVar)%MeshID + do while (VarAry(iVar)%MeshID == MeshID) + select case (VarAry(iVar)%Field) + case (VF_Force) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Force, .true.) + case (VF_Moment) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Moment, .true.) + case (VF_TransDisp) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationDisp, .true.) + case (VF_Orientation) + do j = 1, VarAry(iVar)%Nodes + Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j)) = wm_from_dcm(Mesh%Orientation(:, :, j)) + end do + case (VF_TransVel) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationVel, .true.) + case (VF_AngularVel) + Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationVel, .true.) + case (VF_TransAcc) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationAcc, .true.) + case (VF_AngularAcc) + Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationAcc, .true.) + case (VF_Scalar) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Scalars, .true.) + end select + iVar = iVar + 1 + if (iVar > size(VarAry)) exit + end do +end subroutine + +subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Values(:) + type(MeshType), intent(inout) :: Mesh + integer(IntKi) :: MeshID, j + MeshID = VarAry(iVar)%MeshID + do while (VarAry(iVar)%MeshID == MeshID) + select case (VarAry(iVar)%Field) + case (VF_Force) + Mesh%Force = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Force)) + case (VF_Moment) + Mesh%Moment = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Moment)) + case (VF_TransDisp) + Mesh%TranslationDisp = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationDisp)) + case (VF_Orientation) + do j = 1, VarAry(iVar)%Nodes + Mesh%Orientation(:, :, j) = wm_to_dcm(Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j))) + end do + case (VF_TransVel) + Mesh%TranslationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationVel)) + case (VF_AngularVel) + Mesh%RotationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationVel)) + case (VF_TransAcc) + Mesh%TranslationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationAcc)) + case (VF_AngularAcc) + Mesh%RotationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationAcc)) + case (VF_Scalar) + Mesh%Scalars = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Scalars)) + end select + iVar = iVar + 1 + if (iVar > size(VarAry)) exit + end do +end subroutine + +subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: iLin + integer(IntKi), intent(in) :: PerturbSign + real(R8Ki), intent(in) :: BaseAry(:) + real(R8Ki), intent(inout) :: PerturbAry(:) + integer(IntKi), intent(out) :: iPerturb + real(R8Ki) :: Perturb + real(R8Ki) :: WM(3), WMp(3) + integer(IntKi) :: i, j, iLoc(3) + + ! Copy base array to perturbed array + PerturbAry = BaseAry + + ! Get variable perturbation and combine with sign + Perturb = Var%Perturb*real(PerturbSign, R8Ki) + + ! Perturbation index within array + iPerturb = Var%iLoc(iLin) + + ! If variable field is orientation, perturbation is in WM parameters + if (Var%Field == VF_Orientation) then + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = iLin - j ! index of start of WM parameters (3) + iLoc = Var%iLoc(i:i + 2) ! array index vector + WMp = 0.0_R8Ki ! Init WM perturbation to zero + WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + WM = PerturbAry(iLoc) ! Current WM parameters value + PerturbAry(iLoc) = wm_compose(WM, wm_from_xyz(WMp)) ! Compose value and perturbation + else + PerturbAry(Var%iLoc(iLin)) = PerturbAry(Var%iLoc(iLin)) + Perturb + end if + +end subroutine + +subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: PosAry(:) ! Positive result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative result array + real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference + integer(IntKi) :: i, j, ind(3) + real(R8Ki) :: DeltaWM(3) + + ! Loop through variables + do i = 1, size(VarAry) + + ! If variable field is orientation + if (VarAry(i)%Field == VF_Orientation) then + + ! Loop through nodes + do j = 1, VarAry(i)%Nodes + + ! Get vector of indicies of WM rotation parameters in array + ind = VarAry(i)%iLoc(3*(j - 1) + 1:3*j) + + ! Compose WM parameters to go from negative to positive array + DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) + + ! Calculate change in rotation in XYZ in radians + DiffAry(ind) = wm_to_xyz(DeltaWM) ! store delta as radians + end do + + else + + ! Subtract negative array from positive array + DiffAry(VarAry(i)%iLoc) = PosAry(VarAry(i)%iLoc) - NegAry(VarAry(i)%iLoc) + end if + end do +end subroutine + +subroutine MV_ComputeCentralDiff(VarAry, Delta, PosAry, NegAry, DerivAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: Delta ! Positive perturbation value + real(R8Ki), intent(in) :: PosAry(:) ! Positive perturbation result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative perturbation result array + real(R8Ki), intent(inout) :: DerivAry(:) ! Array containing derivative + + ! Compute difference between all values + call MV_ComputeDiff(VarAry, PosAry, NegAry, DerivAry) + + ! Divide derivative array by twice delta + DerivAry = DerivAry/(2.0_R8Ki*Delta) + +end subroutine + +!------------------------------------------------------------------------------- +! Functions for adding Variables an Modules +!------------------------------------------------------------------------------- + +subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: ModAry(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), pointer, intent(in) :: Vars + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + + ErrStat = ErrID_None + ErrMsg = '' + + ! If module array hasn't been allocated, allocate with zero size + if (.not. allocated(ModAry)) allocate (ModAry(0)) + + ! Populate ModuleDataType derived type + ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & + Ins=Instance, DT=ModDT, Vars=Vars) + + ! Allocate source and destination mapping arrays + call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module data to array + !---------------------------------------------------------------------------- + + ModAry = [ModAry, ModData] + +end subroutine + +subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Fields(:) + integer(IntKi), optional, intent(in) :: Flags + type(MeshType), intent(inout) :: Mesh + real(R8Ki), optional, intent(in) :: Perturbs(:) + integer(IntKi) :: i, FlagsLocal + logical :: ActiveLocal + real(R8Ki), allocatable :: PerturbsLocal(:) + if (.not. Mesh%committed) return + if (allocated(VarAry)) then + Mesh%ID = size(VarAry) + 1 + else + Mesh%ID = 1 + end if + FlagsLocal = 0 + if (present(Flags)) FlagsLocal = Flags + FlagsLocal = ior(FlagsLocal, VF_Mesh) + PerturbsLocal = [(0.0_R8Ki, i=1, size(Fields))] + if (present(Perturbs)) PerturbsLocal = Perturbs + do i = 1, size(Fields) + call MV_AddVar(VarAry, Name, Fields(i), Num=Mesh%Nnodes, Flags=FlagsLocal, & + Perturb=PerturbsLocal(i)) + VarAry(size(VarAry))%MeshID = Mesh%ID + end do +end subroutine + +subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, Active) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr + real(R8Ki), optional, intent(in) :: Perturb + integer(IntKi), optional, intent(in) :: DerivOrder + logical, optional, intent(in) :: Active + character(*), optional, intent(in) :: LinNames(:) + integer(IntKi) :: i + type(ModVarType) :: Var + + ! If active argument specified and not active, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize var with default values + Var = ModVarType(Name=Name, Field=Field) + + ! Set optional values + if (present(Num)) Var%Num = Num + if (present(Flags)) Var%Flags = Flags + if (present(iUsr)) Var%iUsr = [iUsr, iUsr + Var%Num - 1] + if (present(jUsr)) Var%jUsr = jUsr + if (present(Perturb)) Var%Perturb = Perturb + if (present(LinNames)) then + allocate (Var%LinNames(size(LinNames))) + do i = 1, size(LinNames) + Var%LinNames(i) = LinNames(i) + end do + end if + + ! Set Derivative Order + if (present(DerivOrder)) then + Var%DerivOrder = DerivOrder + else + select case (Var%Field) + case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position/displacement + Var%DerivOrder = 0 + case (VF_TransVel, VF_AngularVel) ! Velocity + Var%DerivOrder = 1 + case (VF_TransAcc, VF_AngularAcc) ! Acceleration + Var%DerivOrder = 2 + case default + Var%DerivOrder = -1 + end select + end if + + ! Append Var to VarArray + if (allocated(VarAry)) then + VarAry = [VarAry, Var] + else + VarAry = [Var] + end if +end subroutine + +! Get index of variable in array matching name and field +function MV_VarIndex(VarAry, Name, Field) result(Indx) + type(ModVarType), intent(in) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + integer(IntKi) :: Indx + do Indx = 1, size(VarAry) + if (string_equal_ci(VarAry(Indx)%Name, Name) .and. & + VarAry(Indx)%Field == Field) exit + end do + if (Indx > size(VarAry)) Indx = 0 +end function + +!------------------------------------------------------------------------------- +! Functions for linking variables (Output and Input) +!------------------------------------------------------------------------------- + +subroutine MV_LinkOutputInput(OutVars, InpVars, OutName, InpName, Field, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: OutVars, InpVars + character(*), intent(in) :: OutName, InpName + integer(IntKi), intent(in) :: Field + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_LinkOutputInput' + ! integer(IntKi) :: ErrStat2 + ! character(ErrMsgLen) :: ErrMsg2 + ! integer(IntKi) :: i + integer(IntKi) :: InpVarIndex, OutVarIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Find name/field in input vars + InpVarIndex = MV_VarIndex(InpVars%u, InpName, Field) + if (InpVarIndex == 0) then + call SetErrStat(ErrID_Fatal, 'Input variable "'//InpName//'" with field '// & + trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Find name/field in output vars + OutVarIndex = MV_VarIndex(OutVars%u, OutName, Field) + if (OutVarIndex == 0) then + call SetErrStat(ErrID_Fatal, 'Output variable "'//OutName//'" with field '// & + trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) + return + end if + + ! If error finding input or output variable, return + if (ErrStat >= AbortErrLev) return + + ! TODO: figure out what to do here + +end subroutine + +!------------------------------------------------------------------------------- +! Flag Utilities +!------------------------------------------------------------------------------- + +subroutine SetFlags(Var, Mask) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Mask + integer(IntKi) :: i + Var%Flags = ior(Var%Flags, Mask) +end subroutine + +!------------------------------------------------------------------------------- +! String Utilities +!------------------------------------------------------------------------------- + +! Compare strings s1 and s2 while ignoring case +function string_equal_ci(s1, s2) result(is_equal) + character(*), intent(in) :: s1, s2 + logical :: is_equal + integer(IntKi), parameter :: ca = iachar("a") + integer(IntKi), parameter :: cz = iachar("z") + integer(IntKi) :: i, j + integer(IntKi) :: c1, c2 + is_equal = .false. + i = len_trim(s1) + j = len_trim(s2) + if (i /= j) return + do i = 1, j + c1 = iachar(s1(i:i)) + c2 = iachar(s2(i:i)) + if (c1 == c2) cycle + if (c1 >= ca .and. c1 <= cz) c1 = c1 - 32 + if (c2 >= ca .and. c2 <= cz) c2 = c2 - 32 + if (c1 /= c2) return + end do + is_equal = .true. +end function + +function IdxStr(i1, i2, i3, i4, i5) result(s) + integer(IntKi), intent(in) :: i1 + integer(IntKi), optional, intent(in) :: i2, i3, i4, i5 + character(100) :: s + if (present(i5)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//','//trim(Num2LStr(i5))//')' + else if (present(i4)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//')' + else if (present(i3)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//')' + else if (present(i2)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//')' + else + s = '('//trim(Num2LStr(i1))//')' + end if +end function + +!------------------------------------------------------------------------------- +! Rotation Utilities +!------------------------------------------------------------------------------- + +pure function quat_from_dcm(R) result(q) + real(R8Ki), intent(in) :: R(3, 3) + real(R8Ki) :: q(4), C + integer(IntKi) :: j + + q = [(1.0_R8Ki + R(1, 1) - R(2, 2) - R(3, 3)), & + (1.0_R8Ki - R(1, 1) + R(2, 2) - R(3, 3)), & + (1.0_R8Ki - R(1, 1) - R(2, 2) + R(3, 3)), & + (1.0_R8Ki + R(1, 1) + R(2, 2) + R(3, 3))] + + ! Get index of max value in q + j = maxloc(q, dim=1) + + ! Calculate quaternion from direction cosine matrix + C = q(j) + select case (j) + case (1) + q = [C, (R(1, 2) + R(2, 1)), (R(3, 1) + R(1, 3)), (R(2, 3) - R(3, 2))] + case (2) + q = [(R(1, 2) + R(2, 1)), C, (R(2, 3) + R(3, 2)), (R(3, 1) - R(1, 3))] + case (3) + q = [(R(3, 1) + R(1, 3)), (R(2, 3) + R(3, 2)), C, (R(1, 2) - R(2, 1))] + case (4) + q = [(R(2, 3) - R(3, 2)), (R(3, 1) - R(1, 3)), (R(1, 2) - R(2, 1)), C] + end select + q = q/(2.0_R8Ki*sqrt(C)) + if (q(4) < 0.0_R8Ki) q = -q +end function + +pure function quat_to_dcm(q) result(R) + real(R8Ki), intent(in) :: q(4) + real(R8Ki) :: R(3, 3) + real(R8Ki) :: q1, q2, q3, q4 + q1 = q(1); q2 = q(2); q3 = q(3); q4 = q(4) + R(1, :) = [q4*q4 + q1*q1 - q2*q2 - q3*q3, 2*(q1*q2 + q3*q4), 2*(q1*q3 - q2*q4)] + R(2, :) = [2*(q1*q2 - q3*q4), q4*q4 - q1*q1 + q2*q2 - q3*q3, 2*(q2*q3 + q1*q4)] + R(3, :) = [2*(q1*q3 + q2*q4), 2*(q2*q3 - q1*q4), q4*q4 - q1*q1 - q2*q2 + q3*q3] +end function + +pure function wm_to_quat(c) result(q) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: q(4) + real(R8Ki) :: c0, e0, e(3) + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + e0 = c0/(4.0_R8Ki - c0) + e = c/(4.0_R8Ki - c0) + q = [e, e0] +end function + +pure function wm_from_quat(q) result(c) + real(R8Ki), intent(in) :: q(4) + real(R8Ki) :: c(3) + real(R8Ki) :: e0, e(3) + e0 = q(4) + e = q(1:3) + c = 4.0_R8Ki*e/(1.0_R8Ki + e0) +end function + +! pure function wm_to_dcm(c) result(R) +! real(R8Ki), intent(in) :: c(3) +! real(R8Ki) :: R(3, 3) +! R = quat_to_dcm(wm_to_quat(c)) +! end function + +! pure function wm_to_dcm(c) result(R) +! real(R8Ki), intent(in) :: c(3) +! real(R8Ki) :: R(3, 3), cct, F(3, 3) +! integer(IntKi) :: i, j +! cct = dot_product(c, c) +! F = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3])/2.0_R8Ki +! do i = 1, 3 +! F(i, i) = F(i, i) + 1.0_R8Ki - cct/16.0_R8Ki +! do j = 1, 3 +! F(i, j) = F(i, j) + c(i)*c(j)/8.0_R8Ki +! end do +! end do +! F = F/(1.0_R8Ki + cct/16.0_R8Ki) +! R = matmul(F, F) +! end function + +pure function wm_to_dcm(c) result(R) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: R(3, 3), c0, vc, ct(3, 3) + integer(IntKi) :: i, j + ct(1, :) = [0.0_R8Ki, -c(3), c(2)] + ct(2, :) = [c(3), 0.0_R8Ki, -c(1)] + ct(3, :) = [-c(2), c(1), 0.0_R8Ki] + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + vc = 2.0_R8Ki/(4.0_R8Ki - c0) + R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki + do i = 1, 3 + R(i, i) = R(i, i) + 1.0_R8Ki + end do +end function + +! pure function wm_from_dcm(R) result(c) +! real(R8Ki), intent(in) :: R(3, 3) +! real(R8Ki) :: c(3), cct +! c = wm_from_quat(quat_from_dcm(R)) +! end function + +pure function wm_from_dcm(R) result(c) + real(R8Ki), intent(in) :: R(3, 3) + real(R8Ki) :: pivot(4) ! Trace of the rotation matrix and diagonal elements + real(R8Ki) :: sm(0:3) + real(R8Ki) :: em + real(R8Ki) :: Rr(3, 3), c(3) + integer :: i ! case indicator + + Rr = R + + ! mjs--find max value of T := Tr(Rr) and diagonal elements of Rr + ! This tells us which denominator is largest (and less likely to produce numerical noise) + pivot = (/Rr(1, 1) + Rr(2, 2) + Rr(3, 3), Rr(1, 1), Rr(2, 2), Rr(3, 3)/) + i = maxloc(pivot, 1) - 1 ! our sm array starts at 0, so we need to subtract 1 here to get the correct index + + select case (i) + case (3) + sm(0) = Rr(2, 1) - Rr(1, 2) ! 4 c_0 c_3 t_{r0} + sm(1) = Rr(1, 3) + Rr(3, 1) ! 4 c_1 c_3 t_{r0} + sm(2) = Rr(2, 3) + Rr(3, 2) ! 4 c_2 c_3 t_{r0} + sm(3) = 1.0_R8Ki - Rr(1, 1) - Rr(2, 2) + Rr(3, 3) ! 4 c_3 c_3 t_{r0} + case (2) + sm(0) = Rr(1, 3) - Rr(3, 1) ! 4 c_0 c_2 t_{r0} + sm(1) = Rr(1, 2) + Rr(2, 1) ! 4 c_1 c_2 t_{r0} + sm(2) = 1.0_R8Ki - Rr(1, 1) + Rr(2, 2) - Rr(3, 3) ! 4 c_2 c_2 t_{r0} + sm(3) = Rr(2, 3) + Rr(3, 2) ! 4 c_3 c_2 t_{r0} + case (1) + sm(0) = Rr(3, 2) - Rr(2, 3) ! 4 c_0 c_1 t_{r0} + sm(1) = 1.0_R8Ki + Rr(1, 1) - Rr(2, 2) - Rr(3, 3) ! 4 c_1 c_1 t_{r0} + sm(2) = Rr(1, 2) + Rr(2, 1) ! 4 c_2 c_1 t_{r0} + sm(3) = Rr(1, 3) + Rr(3, 1) ! 4 c_3 c_1 t_{r0} + case (0) + sm(0) = 1.0_R8Ki + Rr(1, 1) + Rr(2, 2) + Rr(3, 3) ! 4 c_0 c_0 t_{r0} + sm(1) = Rr(3, 2) - Rr(2, 3) ! 4 c_1 c_0 t_{r0} + sm(2) = Rr(1, 3) - Rr(3, 1) ! 4 c_2 c_0 t_{r0} + sm(3) = Rr(2, 1) - Rr(1, 2) ! 4 c_3 c_0 t_{r0} + end select + + em = sm(0) + SIGN(2.0_R8Ki*SQRT(sm(i)), sm(0)) + em = 4.0_R8Ki/em ! 1 / ( 4 t_{r0} c_{i} ), assuming 0 <= c_0 < 4 and c_{i} > 0 + c = em*sm(1:3) +end function + +pure function wm_to_xyz(c) result(xyz) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: phi, n(3), xyz(3), m + m = sqrt(dot_product(c,c)) + if (m == 0.0_R8Ki) then + xyz = 0.0_R8Ki + return + end if + n = c/m + phi = 4.0_R8Ki*atan(m/4.0_R8Ki) + xyz = phi*n + ! xyz = c +end function + +pure function wm_from_xyz(xyz) result(c) + real(R8Ki), intent(in) :: xyz(3) + real(R8Ki) :: phi, n(3), c(3) + phi = sqrt(dot_product(xyz,xyz)) + if (phi == 0.0_R8Ki) then + c = 0.0_R8Ki + return + end if + n = xyz / phi + c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n + ! c = xyz +end function + +! pure function wm_from_dcm(R) result(c) +! real(R8Ki), intent(in) :: R(3, 3) +! real(R8Ki) :: c(3), t1, t2, cct +! t1 = 1.0_R8Ki + R(1,1) + R(2,2) + R(3,3) +! t2 = 2.0_R8Ki*sqrt(t1) +! c(1) = (R(3,2) - R(2,3)) +! c(2) = (R(1,3) - R(3,1)) +! c(3) = (R(2,1) - R(1,2)) +! c = 4.0_R8Ki * c / (t1 + t2) +! cct = dot_product(c,c) +! if (cct > 16.0_R8Ki) c = 16.0_R8Ki*c / cct +! end function + +pure function wm_compose(p, q) result(r) + real(R8Ki), intent(in) :: p(3), q(3) + real(R8Ki) :: r(3) + real(R8Ki) :: p0, q0, D1, D2 + p0 = 2.0_R8Ki - dot_product(p, p)/8.0_R8Ki + q0 = 2.0_R8Ki - dot_product(q, q)/8.0_R8Ki + D1 = (4.0_R8Ki - p0)*(4.0_R8Ki - q0) + D2 = p0*q0 - dot_product(p, q) + if (D2 >= 0.0_R8Ki) then + r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 + D2) + else + r = -4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 - D2) + end if +end function + +pure function wm_inv(c) result(cinv) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: cinv(3) + cinv = -c +end function + +pure function cross(a, b) result(c) + real(R8Ki), intent(in) :: a(3), b(3) + real(R8Ki) :: c(3) + c = [a(2)*b(3) - a(3)*b(2), a(3)*b(1) - a(1)*b(3), a(1)*b(2) - b(1)*a(2)] +end function + +end module diff --git a/modules/nwtc-library/src/NWTC_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 diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 13195434b7..51936f4bbf 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -34,6 +34,27 @@ MODULE NWTC_Library_Types USE SysSubs USE ModReg IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -85,6 +106,73 @@ MODULE NWTC_Library_Types CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= +! ========= ModVarType ======= + TYPE, PUBLIC :: ModVarType + character(VarNameLen) :: Name !< [-] + INTEGER(IntKi) :: Field = 0 !< [-] + INTEGER(IntKi) :: Nodes = 1 !< [-] + INTEGER(IntKi) :: Num = 1 !< [-] + INTEGER(IntKi) :: Flags = 0 !< [-] + INTEGER(IntKi) :: DerivOrder = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] + INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] + INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] + LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] + END TYPE ModVarType +! ======================= +! ========= ModVarsType ======= + TYPE, PUBLIC :: ModVarsType + INTEGER(IntKi) :: ModNum = 0 !< [-] + character(6) :: ModAbbr !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + END TYPE ModVarsType +! ======================= +! ========= ModValsType ======= + TYPE, PUBLIC :: ModValsType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< input perturbation array [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yn !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + END TYPE ModValsType +! ======================= +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + LOGICAL :: IsTC = .false. !< Flag indicating module is part of tight coupling [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] + END TYPE ModDataType +! ======================= CONTAINS subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) @@ -659,5 +747,1264 @@ 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(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarTypeData%Name = SrcModVarTypeData%Name + DstModVarTypeData%Field = SrcModVarTypeData%Field + DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes + DstModVarTypeData%Num = SrcModVarTypeData%Num + DstModVarTypeData%Flags = SrcModVarTypeData%Flags + DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder + if (allocated(SrcModVarTypeData%iLoc)) then + LB(1:1) = lbound(SrcModVarTypeData%iLoc) + 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%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%iSol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iSol = SrcModVarTypeData%iSol + end if + if (allocated(SrcModVarTypeData%iLin)) then + LB(1:1) = lbound(SrcModVarTypeData%iLin) + 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%iLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iLin = SrcModVarTypeData%iLin + end if + if (allocated(SrcModVarTypeData%iq)) then + LB(1:1) = lbound(SrcModVarTypeData%iq) + 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%iq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iq = SrcModVarTypeData%iq + end if + DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr + DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr + DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID + DstModVarTypeData%Solve = SrcModVarTypeData%Solve + DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + if (allocated(SrcModVarTypeData%LinNames)) then + LB(1:1) = lbound(SrcModVarTypeData%LinNames) + 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%iLoc)) then + deallocate(ModVarTypeData%iLoc) + end if + if (allocated(ModVarTypeData%iSol)) then + deallocate(ModVarTypeData%iSol) + end if + if (allocated(ModVarTypeData%iLin)) then + deallocate(ModVarTypeData%iLin) + end if + if (allocated(ModVarTypeData%iq)) then + deallocate(ModVarTypeData%iq) + end if + if (allocated(ModVarTypeData%LinNames)) then + deallocate(ModVarTypeData%LinNames) + end if +end subroutine + +subroutine NWTC_Library_PackModVarType(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%Nodes) + call RegPack(Buf, InData%Num) + call RegPack(Buf, InData%Flags) + call RegPack(Buf, InData%DerivOrder) + 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%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%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%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)) + 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(1), UB(1) + 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%Nodes) + if (RegCheckErr(Buf, RoutineName)) return + 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 + 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%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%iSol(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iSol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iSol) + if (RegCheckErr(Buf, RoutineName)) return + end if + 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%iLin(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%iq)) deallocate(OutData%iq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%iq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + 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%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 + 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 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarsTypeData%ModNum = SrcModVarsTypeData%ModNum + DstModVarsTypeData%ModAbbr = SrcModVarsTypeData%ModAbbr + if (allocated(SrcModVarsTypeData%x)) then + LB(1:1) = lbound(SrcModVarsTypeData%x) + 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 +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 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarsTypeData%x)) then + LB(1:1) = lbound(ModVarsTypeData%x) + 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 +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 + integer(IntKi) :: LB(1), UB(1) + 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) + 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 + integer(IntKi) :: LB(1), UB(1) + 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 +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(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstModDataTypeData%Idx = SrcModDataTypeData%Idx + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%IsTC = SrcModDataTypeData%IsTC + DstModDataTypeData%DT = SrcModDataTypeData%DT + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + if (allocated(SrcModDataTypeData%ixs)) then + LB(1:2) = lbound(SrcModDataTypeData%ixs) + 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 + 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) + type(ModDataType), intent(inout) :: ModDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModDataTypeData%ixs)) then + deallocate(ModDataTypeData%ixs) + end if + if (allocated(ModDataTypeData%ius)) then + deallocate(ModDataTypeData%ius) + end if + if (allocated(ModDataTypeData%iys)) then + deallocate(ModDataTypeData%iys) + end if + nullify(ModDataTypeData%Vars) + if (allocated(ModDataTypeData%SrcMaps)) then + deallocate(ModDataTypeData%SrcMaps) + end if + if (allocated(ModDataTypeData%DstMaps)) then + deallocate(ModDataTypeData%DstMaps) + end if +end subroutine + +subroutine NWTC_Library_PackModDataType(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%Idx) + 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)) + 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, 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%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 + +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(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + 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) + 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) + 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 (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%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 a77c60c073..bcdb598af3 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -1,71 +1,154 @@ +# 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_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" + # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types -# 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..0cf5a2a9db --- /dev/null +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -0,0 +1,119 @@ +# 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_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" diff --git a/modules/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 diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index d6d973f5e1..52c0d06d04 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -61,12 +61,26 @@ 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..0685164fed --- /dev/null +++ b/modules/openfast-library/src/FAST_Eval.f90 @@ -0,0 +1,2499 @@ +!******************************************************************************* +! 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 +use FAST_ModTypes +use NWTC_LAPACK +use AeroDyn +use BeamDyn +use ElastoDyn +use HydroDyn +use InflowWind +use SeaState +use ServoDyn +use SubDyn + +implicit none + +! Input Solve destinations +integer(IntKi), parameter :: IS_Input = 1, IS_u = 2 + +#define SOLVER_DEBUG + +contains + +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 + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_ExtrapInterp' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%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(:, 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, 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(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) + + 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) + + ! 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 + 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) + + 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 + 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(ModData%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_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 + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InitIO' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(DbKi) :: t_global_next ! Simulation time for computing outputs + integer(IntKi) :: i, j, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through modules + do i = 1, size(Mods) + + ! 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 + + ! Select based on module ID + select case (Mods(i)%ID) + + 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) + + 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 + + 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) + + 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(Mods(i)%ID)), 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_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 + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_UpdateStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + 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 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Copy from current to predicted state (MESH_UPDATECOPY) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Select based on module ID + select case (ModData%ID) + + case (Module_AD) + + 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 + + case (Module_BD) + + 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(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(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 + + ! 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(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(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 + + ! 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) + + 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(p_ED, x_ED, T%p_FAST%DT) + + ! 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) + case (Module_HD) + + 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 + +! case (Module_IceD) +! case (Module_IceF) + case (Module_IfW) + + 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 + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + case (Module_SD) + + 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) + + 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(ModData%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_InitMappings(Maps, Mods, T, ErrStat, ErrMsg) + type(TC_MappingType), allocatable, intent(inout) :: Maps(:) + type(ModDataType), intent(inout) :: Mods(:) !< Module data + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_InitMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j, k + integer(IntKi) :: iMap, ModIns, iModIn, iModSrc, iModDst + + 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 module pairings + do iModSrc = 1, size(Mods) + do iModDst = 1, size(Mods) + associate (ModSrc => Mods(iModSrc), ModDst => Mods(iModDst)) + + ! Switch by destination module + select case (ModDst%ID) + +!------------------------------------------------------------------------------- +! Module_AD Inputs +!------------------------------------------------------------------------------- + case (Module_AD) + + select case (ModSrc%ID) + case (Module_ED) + + 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) + 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 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 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 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 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 NonMeshMap(Maps, Key='SrvD BlAirfoilCom -> AD UserProp', SrcMod=ModSrc, DstMod=ModDst) + + end select + +!------------------------------------------------------------------------------- +! Module_BD Inputs +!------------------------------------------------------------------------------- + case (Module_BD) + + select case (ModSrc%ID) + case (Module_ED) + + 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 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) + + end select + +!------------------------------------------------------------------------------- +! Module_ED Inputs +!------------------------------------------------------------------------------- + case (Module_ED) + + select case (ModSrc%ID) + case (Module_BD) + + 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 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 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) + 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 + + case (Module_SD) + + 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 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 + + 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 + +!------------------------------------------------------------------------------- +! Module_IfW Inputs +!------------------------------------------------------------------------------- + case (Module_IfW) + + select case (ModSrc%ID) + case (Module_ED) + call NonMeshMap(Maps, "ED HubMotion -> IfW HubMotion", SrcMod=ModSrc, DstMod=ModDst) + end select + +!------------------------------------------------------------------------------- +! 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 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 NonMeshMap(Maps, "ED Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) + if (T%p_FAST%CompElast == Module_ED) then + call NonMeshMap(Maps, "ED RootM -> SrvD RootM", SrcMod=ModSrc, DstMod=ModDst) + end if + case (Module_IfW) + call NonMeshMap(Maps, "IfW Data -> SrvD Data", SrcMod=ModSrc, DstMod=ModDst) + end select + + end select + end associate + end do + end do + + !---------------------------------------------------------------------------- + ! 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), & + SrcMod => Mods(Maps(iMap)%SrcModIdx), & + DstMod => Mods(Maps(iMap)%DstModIdx)) + + ! Add mapping index to sorce and destination module mapping arrays + SrcMod%SrcMaps = [SrcMod%SrcMaps, iMap] + DstMod%DstMaps = [DstMod%DstMaps, iMap] + + ! Switch based on mapping type + select case (Map%Typ) + case (Map_LoadMesh) + + ! 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) + 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) + 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) 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 + SrcMod%Vars%y(map%SrcVarIdx)%Solve = .true. + DstMod%Vars%u(map%DstVarIdx)%Solve = .true. + + ! 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) + + ! 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) 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 + SrcMod%Vars%y(map%SrcVarIdx)%Solve = .true. + DstMod%Vars%u(map%DstVarIdx)%Solve = .true. + + 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 + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +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 + + character(*), parameter :: RoutineName = 'MotionMeshMap' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(TC_MappingType) :: Mapping + + ErrStat = ErrID_None + ErrMsg = '' + + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if + + ! 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 + + ! Initialize mapping structure + 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 + + ! Create a copy of destination mesh in mapping for load summation + call MeshCopy(DstMesh, Mapping%MeshTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Key) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +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 + + character(*), parameter :: RoutineName = 'MotionMeshMap' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(TC_MappingType) :: Mapping + + ErrStat = ErrID_None + ErrMsg = '' + + ! If active argument is set to false, return + if (present(Active)) then + if (.not. Active) return + end if + + ! 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 + + ! Initialize mapping structure + 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 + + ! Add mapping to array of mappings + Mappings = [Mappings, Mapping] + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//Key) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +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 + type(TC_MappingType) :: Mapping + if (present(Active)) then + if (.not. Active) return + end if + + ! 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) + 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 + 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) + 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 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), 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, j, k_bl, k_bn + + 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 + + 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) + if (Failed()) return + + case ('ED BladeMotion -> AD BladeMotion') + 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)%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, 'Unknown Mapping Key: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) + return + end select + 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 + +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), 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: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) + return + end select + 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 + +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, j + logical :: ResetHubLoads + logical :: ResetNacelleLoads + logical :: ResetPlatformLoads + logical :: ResetBladeLoads + logical :: ResetTowerLoads + + ErrStat = ErrID_None + ErrMsg = '' + + ResetHubLoads = .true. + ResetNacelleLoads = .true. + ResetPlatformLoads = .true. + ResetBladeLoads = .true. + ResetTowerLoads = .true. + + ! Zero tower and platform added mass + ! u_ED%TwrAddedMass = 0.0_ReKi + ! u_ED%PtfmAddedMass = 0.0_ReKi + + ! 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)%i1), & + u_ED%BladePtLoads(Maps(i)%i1), & + 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 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 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) + if (Failed()) return + call SumMeshLoads(Maps(i)%MeshTmp, u_ED%NacelleLoads, ResetNacelleLoads) + + case ('AD HubLoad -> ED HubLoad') + 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) + 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, & + 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, & + 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 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) + 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 + u_ED%BlPitchCom = T%SrvD%y%BlPitchCom + u_ED%YawMom = T%SrvD%y%YawMom + + case default + 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="'//trim(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) + + ! 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: "'//trim(Maps(i)%Key)//'"', ErrStat, ErrMsg, RoutineName) + return + end select + 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 + +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 + +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: "'//trim(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 /= ErrID_None + if (Failed) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Key="'//trim(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) + 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 + type(FAST_TurbineType), intent(inout) :: T !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CalcOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + 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) + + 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) + + 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) +! case (Module_ExtPtfm) +! case (Module_FEAM) + 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) + 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) + +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + 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) + + 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. +end subroutine + +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 + 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 (ModData%ID) + +! case (Module_AD) + + case (Module_BD) + + 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) + call XferLocToGbl1D(ModData%ixs, T%BD%m(ModData%Ins)%Vals%dxdt, dxdt) + end if + + case (Module_ED) + + 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) + call XferLocToGbl1D(ModData%ixs, T%ED%m%Vals%dxdt, dxdt) + end if + +! case (Module_ExtPtfm) +! case (Module_FEAM) + 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) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + 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 + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%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_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) + + 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) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + + 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 + 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 + 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(:, :) + + character(*), parameter :: RoutineName = 'FAST_JacobianPContState' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + 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) + +! 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) + 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) + 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) + 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) + 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) + 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) + 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) + 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) +! case (Module_MAP) +! case (Module_MD) +! case (Module_OpFM) +! case (Module_Orca) + 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 + call SetErrStat(ErrID_Fatal, "Unknown module ID "//trim(Num2LStr(ModData%ID)), ErrStat, ErrMsg, RoutineName) + return + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':'//ModData%Abbr) +end subroutine + +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(ModData, T, STATE_PRED, STATE_CURR, MESH_UPDATECOPY, ErrStat, ErrMsg) +end subroutine + +subroutine XferLocToGbl1D(Inds, Loc, Gbl) + integer(IntKi), intent(in) :: Inds(:, :) + real(R8Ki), intent(in) :: Loc(:) + real(R8Ki), intent(inout) :: Gbl(:) + 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(:) + 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(:, :) + 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(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 + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'FAST_CopyStates' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + 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 + + ErrStat = ErrID_None + ErrMsg = '' + + ! Select based on module ID + select case (ModData%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(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) + + 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) + + ! TODO: Fix inconsistent function name + call HydroDyn_CopyContState(T%HD%x(Src), T%HD%x(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) + 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) + + 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) + + 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(ModData%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_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 + + character(*), parameter :: RoutineName = 'FAST_ResetRemapFlags' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, k + + ErrStat = ErrID_None + ErrMsg = '' + + ! 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 + + do i = 1, size(Mods) + + ! Select based on module ID + select case (Mods(i)%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 + + if (T%AD%Input(1)%rotors(1)%TowerMotion%Committed) then + T%AD%Input(1)%rotors(1)%TowerMotion%RemapFlag = .false. + + if (T%AD%y%rotors(1)%TowerLoad%Committed) then + T%AD%y%rotors(1)%TowerLoad%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)%TFinMotion%Committed) then + T%AD%Input(1)%rotors(1)%TFinMotion%RemapFlag = .false. + T%AD%y%rotors(1)%TFinLoad%RemapFlag = .false. + 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 + + case (Module_BD) + + 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%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 + 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) + + T%FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .false. + T%FEAM%y%PtFairleadLoad%RemapFlag = .false. + + 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 + + case (Module_IceD) + + 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) + + 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) + + T%MAP%Input(1)%PtFairDisplacement%RemapFlag = .false. + T%MAP%y%PtFairleadLoad%RemapFlag = .false. + + case (Module_MD) + + T%MD%Input(1)%CoupledKinematics(1)%RemapFlag = .false. + T%MD%y%CoupledLoads(1)%RemapFlag = .false. + + case (Module_Orca) + + T%Orca%Input(1)%PtfmMesh%RemapFlag = .false. + T%Orca%y%PtfmMesh%RemapFlag = .false. + + 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)%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 do + +end subroutine + +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) :: Maps(:) + 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_LinearizeMappings' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = '' + + ! Loop through mapping array + do i = 1, size(Maps) + + ! If source or destination modules are not in tight coupling + ! or mapping is non-mesh, cycle + if (Maps(i)%Typ == Map_NonMesh) cycle + + ! Select based on mapping Key + 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, & + 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) + + case ('BD ReactionForce -> ED HubLoad') + 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) + + 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: "'//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 + if (present(dUdy)) then + call dUdySetBlocks(Maps(i), ModData(Maps(i)%SrcModIdx), ModData(Maps(i)%DstModIdx), Maps(i)%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 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 + + ! 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)%Num + do ic = 1, size(ColVars) + if (ColVars(ic)%Field /= ColField) cycle + nSize = ColVars(ic)%Num + 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 + end do + m = m + mSize + end do + end subroutine +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..9ec6f4abb6 --- /dev/null +++ b/modules/openfast-library/src/FAST_Lin_TC.f90 @@ -0,0 +1,6952 @@ +!********************************************************************************************************************************** +! 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 NWTC_LAPACK + + 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) + 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' ) + + 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 (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 + 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..4272ae3755 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -88,6 +88,100 @@ 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 ............. + +# Mapping Type +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 ^ ^ IntKi i1 - 0 - "Optional index for specifying transfers" - +typedef ^ ^ IntKi i2 - 0 - "Optional index for specifying transfers" - +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 Source has been ready to be transferred" - +typedef ^ ^ MeshType MeshTmp - - - "Temporary mesh for intermediate transfers" - +typedef ^ ^ MeshMapType MeshMap - - - "Mesh mapping from Source variable to Destination variable" - + +# 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 7 - - "Generalized-alpha coefficient array" - +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 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 :: - - "" - +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 GinvdUdu :: - - "" - +typedef ^ ^ R8Ki dUdyHat :: - - "" - +typedef ^ ^ R8Ki XB :: - - "" - +typedef ^ ^ R8Ki G :: - - "Used to merge state matrices" - +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 : - - "" - +typedef ^ ^ R8Ki UDiff : - - "" - +typedef ^ ^ logical ConvWarn - - - "Flag to warn about convergence failure" - +typedef ^ ^ TC_MappingType Mappings : - - "Array of mesh mappings in solver" - + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: @@ -196,6 +290,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) @@ -361,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 ....................................................................................................... @@ -384,6 +479,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 +494,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 +575,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" @@ -518,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" @@ -697,6 +796,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..c4e5bfef21 --- /dev/null +++ b/modules/openfast-library/src/FAST_Subs_TC.f90 @@ -0,0 +1,7995 @@ +!********************************************************************************************************************************** +! 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, 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, 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, Turbine, 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, Turbine, 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_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) + + ! 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 + + ! 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 + + 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%dxdt( p_FAST%nBeams ), & + 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 + + ! 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 + + 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) + + 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 ) + 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) + + 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 + + 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) + + ! 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() + 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) + + ! 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 + 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) + + ! 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 ) + 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) + + 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) + 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 + + + + + ! ------------------------------------------------------------------------- + ! Initialize tight coupling solver + ! ------------------------------------------------------------------------- + + 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() + 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 + ! ------------------------------------------------------------------------- + + 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( 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) +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 + !...................................................... + + 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 + + y_FAST%ChannelNames(1) = 'Time' + y_FAST%ChannelUnits(1) = '(s)' + + 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) + 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 + + 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, 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,& + ! 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, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +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 + + 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 = '' + + ! 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 + + ! 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 ) + + !---------------------------------------------------------------------------- + ! 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 +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) > 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 + + 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..c70c1007be 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) [-] @@ -109,6 +112,101 @@ 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_MappingType ======= + TYPE, PUBLIC :: TC_MappingType + character(VarNameLen) :: Key = '' !< Mapping Key [-] + INTEGER(IntKi) :: i1 = 0 !< Optional index for specifying transfers [-] + INTEGER(IntKi) :: i2 = 0 !< Optional index for specifying transfers [-] + 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 Source has been ready to be transferred [-] + TYPE(MeshType) :: MeshTmp !< Temporary mesh for intermediate transfers [-] + TYPE(MeshMapType) :: MeshMap !< Mesh mapping from Source variable to Destination variable [-] + END TYPE TC_MappingType +! ======================= +! ========= 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: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 !< [-] + 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 :: 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 ======= + 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 :: 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) :: 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 !< [-] + 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 +! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] @@ -205,6 +303,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 ======= @@ -362,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 ======= @@ -382,6 +483,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 +500,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 +594,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 [-] @@ -537,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 [-] @@ -715,6 +820,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,129 +1389,1724 @@ 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_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_MappingType' + ErrStat = ErrID_None + ErrMsg = '' + DstTC_MappingTypeData%Key = SrcTC_MappingTypeData%Key + 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 + 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) + 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_MappingTypeData%SrcVarIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_MappingTypeData%SrcVarIdx = SrcTC_MappingTypeData%SrcVarIdx + end if + 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_MappingTypeData%DstVarIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + 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 + 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 +end subroutine + +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_MappingType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TC_MappingTypeData%SrcVarIdx)) then + deallocate(TC_MappingTypeData%SrcVarIdx) + end if + if (allocated(TC_MappingTypeData%DstVarIdx)) then + deallocate(TC_MappingTypeData%DstVarIdx) + end if + call MeshDestroy( TC_MappingTypeData%MeshTmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(TC_MappingTypeData%MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackTC_MappingType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + 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%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, 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)) + 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%SrcDispMeshID) + call RegPack(Buf, InData%DstDispMeshID) + call RegPack(Buf, InData%SrcDispVarIdx) + call RegPack(Buf, InData%DstDispVarIdx) + call RegPack(Buf, InData%Typ) + call RegPack(Buf, InData%Ready) + call MeshPack(Buf, InData%MeshTmp) + call NWTC_Library_PackMeshMapType(Buf, InData%MeshMap) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTC_MappingType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TC_MappingType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTC_MappingType' + 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%i1) + if (RegCheckErr(Buf, RoutineName)) return + 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) + 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 + 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%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) + if (RegCheckErr(Buf, RoutineName)) return + 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) + 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 + 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%iJL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iJL = SrcTC_ParameterTypeData%iJL + 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%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%iModInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTC_ParameterTypeData%iModInit = SrcTC_ParameterTypeData%iModInit + 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%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) + 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 + 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) + 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%iJL)) then + deallocate(TC_ParameterTypeData%iJL) + end if + if (allocated(TC_ParameterTypeData%ixqd)) then + deallocate(TC_ParameterTypeData%ixqd) + end if + if (allocated(TC_ParameterTypeData%iModInit)) then + deallocate(TC_ParameterTypeData%iModInit) + 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 + if (allocated(TC_ParameterTypeData%iModOpt1US)) then + deallocate(TC_ParameterTypeData%iModOpt1US) + end if + 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) + 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, 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%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 + 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)) + 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 + 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 + +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 + call RegUnpack(Buf, OutData%iX1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iX2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iUT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iU1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iyT) + if (RegCheckErr(Buf, RoutineName)) return + 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%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%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%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%iModInit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModInit) + 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%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%iModBD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%iModBD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%iModBD) + 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 + 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) + 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 = '' + 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%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) + 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%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) + 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 + 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 + 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) + 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_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 + 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 + 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 = '' + 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%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%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 + 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_MappingType(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 + 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%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)) + 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 + 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, InData%ConvWarn) + 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_MappingType(Buf, InData%Mappings(i1)) + end do + 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) :: i1, i2 + 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 + 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%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 + 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 + 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 + 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 (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, 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%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 + if (allocated(OutData%dUdu)) deallocate(OutData%dUdu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + 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 - 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%dUdy)) deallocate(OutData%dUdy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + 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 - 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%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 -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, 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 - call RegUnpack(Buf, OutData%MatlabFileName) + 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%G)) deallocate(OutData%G) + 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%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 - if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + 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%VTKModes(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%VTKModes.', 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%VTKModes) + call RegUnpack(Buf, OutData%IPIV) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%VTKLinTim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKNLinTimes) + call RegUnpack(Buf, OutData%IterTotal) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinScale) + call RegUnpack(Buf, OutData%IterUntilUJac) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinPhase) + call RegUnpack(Buf, OutData%StepsUntilUJac) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) + 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%DampingRatio(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%DampingRatio.', 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%DampingRatio) + call RegUnpack(Buf, OutData%dq) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) + 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%NaturalFreq_Hz(LB(1):UB(1)),stat=stat) + allocate(OutData%dx(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%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%NaturalFreq_Hz) + call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) + if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DampedFreq_Hz(LB(1):UB(1)),stat=stat) + allocate(OutData%du(LB(1):UB(1)),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%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%DampedFreq_Hz) + call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) + if (allocated(OutData%UDiff)) deallocate(OutData%UDiff) 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%UDiff(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%UDiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%x_eig_magnitude) + call RegUnpack(Buf, OutData%UDiff) if (RegCheckErr(Buf, RoutineName)) return end if - if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) + 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 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%Mappings(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%Mappings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%x_eig_phase) - if (RegCheckErr(Buf, RoutineName)) return + do i1 = LB(1), UB(1) + call FAST_UnpackTC_MappingType(Buf, OutData%Mappings(i1)) ! Mappings + end do end if end subroutine @@ -1517,6 +3219,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 +3237,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 +3340,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 +3535,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) @@ -6643,7 +8352,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) @@ -6679,6 +8423,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) @@ -6727,7 +8480,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 @@ -6827,8 +8594,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) @@ -7426,6 +9233,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 +9455,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 +9587,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 +9730,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 +9941,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 +10043,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 +10108,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 +10169,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 +11559,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 +11661,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 +11726,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 +11787,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) @@ -10564,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) @@ -10663,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) @@ -10726,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) @@ -10786,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) @@ -13832,11 +15709,13 @@ 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 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 +15736,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 +15772,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 +15803,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 +15820,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 +15845,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..d3680642c1 --- /dev/null +++ b/modules/openfast-library/src/Solver.f90 @@ -0,0 +1,1562 @@ +module Solver + +use NWTC_LAPACK +use FAST_Solver +use FAST_ModTypes +use FAST_Eval +use ElastoDyn +use BeamDyn +use SubDyn +use AeroDyn +use AeroDyn14 +use ServoDyn +use SC_DataEx + +implicit none + +private + +! 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] + +! Debugging +logical, parameter :: DebugSolver = .false. +integer(IntKi) :: DebugUn = -1 +character(*), parameter :: DebugFile = 'solver.dbg' +logical, parameter :: DebugJacobian = .false. +integer(IntKi) :: MatrixUn = -1 + +contains + +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 + integer(IntKi) :: NumX, NumQ, NumU, NumY, NumJ + 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))] + + ! 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), & + 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(modInds, ModIDs == Module_ExtPtfm), & + 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)] + + ! 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) + !---------------------------------------------------------------------------- + + call FAST_InitMappings(m%Mappings, Mods, Turbine, 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 + + !---------------------------------------------------------------------------- + ! 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 + + !---------------------------------------------------------------------------- + ! 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 + !---------------------------------------------------------------------------- + + 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, num + + 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 + NumX = 0 + + ! Loop through tight coupling modules, set Solve flag for all states + do i = 1, size(p%iModTC) + 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) + 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 + p%iX1 = [1, NumX] + + ! Loop through x velocity variables (DerivOrder == 1), set global index + do i = 1, size(p%iModTC) + 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 + 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)%iSol] + end do + call AllocAry(Mod%ixs, 2, size(vec1), "Mod%ixs", ErrStat2, ErrMsg2); if (Failed()) return + if (size(vec1) > 0) then + Mod%ixs(1, :) = vec1 + Mod%ixs(2, :) = vec2 + end if + 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 + + ! Loop through tight coupling modules and calculate global indices + do i = 1, size(p%iModTC) + call SetGlobalIndices(Mods(p%iModTC(i))%Vars%u, NumU) + end do + + ! 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) + call SetGlobalIndices(Mods(p%iModOpt1(i))%Vars%u, NumU) + end do + + ! Save number of option 1 inputs + p%iU1 = [p%iUT(2) + 1, NumU] + + ! Loop through all modules + 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)%iSol)) cycle + vec1 = [vec1, Mods(i)%Vars%u(j)%iLoc] + 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)%iSol] + end select + end do + call AllocAry(Mods(i)%ius, 2, size(vec1), "Mods(i)%ius", ErrStat2, ErrMsg2); if (Failed()) return + if (size(vec1) > 0) then + Mods(i)%ius(1, :) = vec1 + Mods(i)%ius(2, :) = vec2 + end if + deallocate (vec1, vec2) + end do + + !---------------------------------------------------------------------------- + ! Calculate output variable categories and indices + !---------------------------------------------------------------------------- + + ! Initialize the number of output variables + NumY = 0 + + ! Loop through tight coupling modules and calculate output global indices + do i = 1, size(p%iModTC) + 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 output global indices + do i = 1, size(p%iModOpt1) + call SetGlobalIndices(Mods(p%iModOpt1(i))%Vars%y, NumY) + 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)%iSol)) cycle + vec1 = [vec1, Mods(i)%Vars%y(j)%iLoc] + 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 + if (size(vec1) > 0) then + Mods(i)%iys(1, :) = vec1 + Mods(i)%iys(2, :) = vec2 + end if + deallocate (vec1, vec2) + end do + + !---------------------------------------------------------------------------- + ! 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 + num = 0 + + ! Loop through modules + do i = 1, size(Mods) + + ! Skip modules that aren't in tight coupling + if (all(Mods(i)%ID /= TC_Modules)) cycle + + ! Loop through state variables + do j = 1, size(Mods(i)%Vars%x) + + ! Skip variables which already have a q index + 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 + 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) + + ! If names are different then they don't match, skip + 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 (Mods(i)%Vars%x(j)%Field) + case (VF_TransDisp, VF_TransVel, VF_TransAcc) + if (all(Mods(i)%Vars%x(k)%Field /= TransFields)) cycle + case (VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc) + if (all(Mods(i)%Vars%x(k)%Field /= AngularFields)) cycle + case (VF_Force, VF_Moment) + cycle + end select + + ! Copy q row indices + Mods(i)%Vars%x(k)%iq = Mods(i)%Vars%x(j)%iq + + 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(Mods(i)%Vars%x) + do k = 1, Mods(i)%Vars%x(j)%Num + num = num + 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 + + end do + + ! Remove unused x->q indicies + p%ixqd = p%ixqd(:, 1:num) + + !---------------------------------------------------------------------------- + ! Jacobian indices and ranges + !---------------------------------------------------------------------------- + + ! Calculate size of Jacobian matrix + NumJ = NumQ + NumU + + ! Get start and end indicies for state part of Jacobian + p%iJX = [1, NumQ] + + ! 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 = 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 + end function +end subroutine + +subroutine 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 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 + +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) :: Mods(:) !< Module data + 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 + logical, parameter :: IsSolve = .true. + integer(IntKi) :: i, j, k + real(R8Ki), allocatable :: accel(:) + real(R8Ki) :: ConvError + 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 setup + !---------------------------------------------------------------------------- + + 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) + + ! Set flag to warn about convergence errors + m%ConvWarn = .true. + + !---------------------------------------------------------------------------- + ! Calculate initial accelerations + !---------------------------------------------------------------------------- + + ! Transfer initial state from modules to solver + 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) + + ! 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) + + ! 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 + converged = .false. + k = 0 + 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) + call FAST_InputSolve(Mods(p%iModInit(i)), m%Mappings, IS_Input, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + 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(Mods(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 + ! 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 convergence error as L2 norm of diff between current and new accelerations + ConvError = TwoNorm(accel - m%qn(:, COL_A)) + + ! 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 + + ! Increment iteration counter + k = k + 1 + end do + + ! Print warning if not converged + if (.not. converged) call WrScr("Solver: initial accel not converged, diff="// & + trim(Num2LStr(ConvError))//", tol="//trim(Num2LStr(p%ConvTol))) + + ! Initialize algorithmic acceleration from actual acceleration + m%qn(:, COL_AA) = m%qn(:, COL_A) + m%q = 0.0_R8Ki + + !---------------------------------------------------------------------------- + ! Initialize module input and state arrays for interpolation/extrapolation + !---------------------------------------------------------------------------- + + ! 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(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) + Failed = ErrStat >= AbortErrLev + end function +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 + type(TC_ParameterType), intent(in) :: p !< Parameters + type(TC_MiscVarType), intent(inout) :: m !< Misc variables + type(ModDataType), intent(in) :: Mods(:) !< Module data + 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 + logical, parameter :: IsSolve = .true. + 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 + integer(IntKi) :: i, j + logical :: ConvUJac ! Jacobian updated for convergence + + 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) + + ! 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 + !---------------------------------------------------------------------------- + + ! Loop through all modules and extrap/interp inputs + do i = 1, size(Mods) + call FAST_ExtrapInterp(Mods(i), t_global_next, Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do + + !---------------------------------------------------------------------------- + ! 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. + !---------------------------------------------------------------------------- + + ! Acceleration for next step + m%q(:, COL_A) = p%AccBlend*m%qn(:, COL_A) + + ! 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.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%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%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 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 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 + !---------------------------------------------------------------------------- + + ! Loop through correction iterations + iterCorr = 0 + NumCorrections = p%NumCrctn + do while (iterCorr <= NumCorrections) + + ! Copy state for correction step + m%qn = m%q + m%xn = m%x + + ! Reset mapping ready flags + m%Mappings%Ready = .false. + + !------------------------------------------------------------------------- + ! Option 2 Solve + !------------------------------------------------------------------------- + + ! Loop through Option 2 modules + do i = 1, size(p%iModOpt2) + 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)), m%Mappings, t_global_next, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + 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, 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 + end do + + ! Populate state matrix with latest values from state array in case it + ! changed during FAST_UpdateStates calls + call TransferXtoQ(p%ixqd, m%xn, m%qn) + + ! Pack Option 1 inputs into u array + call PackModuleInputs(Mods, p%iModOpt1, Turbine, u=m%un) + + !------------------------------------------------------------------------- + ! Convergence Iterations + !------------------------------------------------------------------------- + + ! 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 + + !---------------------------------------------------------------------- + ! Option 1 calculate outputs + !---------------------------------------------------------------------- + + do i = 1, size(p%iModOpt1) + call FAST_CalcOutput(Mods(p%iModOpt1(i)), m%Mappings, t_global_next, STATE_PRED, & + Turbine, ErrStat2, ErrMsg2); if (Failed()) return + end do + + !---------------------------------------------------------------------- + ! Convergence iteration check + !---------------------------------------------------------------------- + + ! 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 + + ! Exit convergence loop to next correction iteration or next step + exit + end if + + !---------------------------------------------------------------------- + ! Update Jacobian + !---------------------------------------------------------------------- + + ! 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: 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 + + !---------------------------------------------------------------------- + ! Formulate right hand side (X_2^tight, U^tight, U^Option1) + !---------------------------------------------------------------------- + + ! 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 + end do + + ! Calculate difference between predicted and actual accelerations + 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) + 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) + + ! 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 + + ! 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 + + !---------------------------------------------------------------------- + ! 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) + + ! 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 + + ! 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 + + !---------------------------------------------------------------------- + ! Update State for Tight Coupling modules + !---------------------------------------------------------------------- + + ! 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) + + ! Update state matrix with deltas + m%qn = m%qn + m%dq + + ! 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) + + ! 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 TransferXtoQ(p%ixqd, m%xn, m%qn) + + ! 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 = m%XB(p%iJU(1):p%iJU(2), 1) + + ! Apply deltas to inputs, update modules + 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) + + end do + + ! Increment correction iteration counter + iterCorr = iterCorr + 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 + end do + + ! Reset mesh remap + call FAST_ResetRemapFlags(Mods, m%Mappings, Turbine, ErrStat2, ErrMsg2) + if (Failed()) return + end do + + !---------------------------------------------------------------------------- + ! Update states for next step + !---------------------------------------------------------------------------- + + ! Update state matrix from state array + 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(Mods) + 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 + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +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) :: ThisTime !< Time + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'BuildJacobian' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + logical, parameter :: IsSolve = .true. + integer(IntKi) :: i, j + + ErrStat = ErrID_None + ErrMsg = '' + + ! Reset Jacobian update countdown values + m%IterUntilUJac = p%NIter_UJac + m%StepsUntilUJac = p%NStep_UJac + + if (size(m%Jac) == 0) return + + !---------------------------------------------------------------------------- + ! Get module Jacobians and assemble + !---------------------------------------------------------------------------- + + ! Initialize Jacobian 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_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_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 + + !---------------------------------------------------------------------------- + ! 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 + + !---------------------------------------------------------------------------- + ! Assemble Jacobian + !---------------------------------------------------------------------------- + + ! Group (1,1) + 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%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%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 + + ! 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) + if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +subroutine AddDeltaToStates(Mods, ModOrder, dx, x) + type(ModDataType), intent(in) :: Mods(:) !< Module data + 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 module variables based on order array + do i = 1, size(ModOrder) + 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%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)%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%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 + end associate + end do + end do + +end subroutine + +subroutine AddDeltaToInputs(Mods, ModOrder, du, u) + type(ModDataType), intent(in) :: Mods(:) !< Module data + integer(IntKi), intent(in) :: ModOrder(:) + real(R8Ki), intent(in) :: du(:) + 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) + + ! Loop through variables + 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 (.not. Var%Solve) 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%iSol) = u(Var%iSol) + du(Var%iSol) + case (VF_AngularDisp) + ! Add delta u to u and limit to between -2pi and 2pi + ! 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%iSol), 3 + ind = Var%iSol(k:k + 2) + u(ind) = wm_compose(wm_from_xyz(du(ind)), u(ind)) + end do + end select + + end associate + end do + 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%iSol)) 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%iSol(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%iSol) = PosAry(Var%iSol) - NegAry(Var%iSol) + end if + end associate + end do + end do +end subroutine + +subroutine PackModuleStates(ModData, this_state, T, x) + 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 + do j = 1, size(ModData) + ii = ModData(j)%Ins + select case (ModData(j)%ID) + 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(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 + +end subroutine + +subroutine UnpackModuleStates(ModData, ModOrder, this_state, T, x) + 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 + 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_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 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 +end subroutine + +! PackModuleInputs packs input values from Option 1 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(:) + integer(IntKi) :: j + + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + 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(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 + +end subroutine + +! 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(inout) :: u(:) + integer(IntKi) :: j + + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + 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(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 + +end subroutine + +! 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(in) :: u(:) + integer(IntKi) :: j + + do j = 1, size(ModOrder) + associate (Mod => ModData(ModOrder(j))) + select case (Mod%ID) + 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_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 + +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,*(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) + 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)%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 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)%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 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)%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 iSol = ", Mods(i)%Vars%y(j)%iSol + 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)%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 + +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 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."; + } } } 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/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 ) 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 diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 1258379d05..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 @@ -389,6 +391,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(Init, InitInput, u, p, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return ! Tell GLUECODE the SubDyn timestep interval Interval = p%SDdeltaT @@ -413,6 +418,207 @@ 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(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(INOUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SD_ParameterType), INTENT(INOUT) :: p !< Parameters + 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 + 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 + real(ReKi) :: dx, dy, dz, maxDim + + ! 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 + !---------------------------------------------------------------------------- + + 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 + !---------------------------------------------------------------------------- + + 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 + 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 + 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 + 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. @@ -1926,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 @@ -1938,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 @@ -2050,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 @@ -2242,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() 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)