diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index c29ac947bf..5155d6c71a 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -450,7 +450,11 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%Waves%WaveFieldMod = InitInp%WaveFieldMod InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY - + + ! Were visualization meshes requested? + p%VisMeshes = InitInp%VisMeshes + + ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data @@ -1367,9 +1371,11 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ELSE InputFileData%Morison%OutSwtch = 0 END IF + + ! Were visualization meshes requested? + InputFileData%Morison%VisMeshes = p%VisMeshes ! Initialize the Morison Element Calculations - CALL Morison_Init(InputFileData%Morison, u%Morison, p%Morison, x%Morison, xd%Morison, z%Morison, OtherState%Morison, & y%Morison, m%Morison, Interval, InitOut%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 541a6dbcce..45a63e0c65 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -87,6 +87,7 @@ typedef ^ ^ SiKi typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" +typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # # # Define outputs from the initialization routine here: @@ -218,6 +219,7 @@ typedef ^ ^ Integer typedef ^ ^ R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" - typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" - typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 4777387fd3..f0bbf9b23a 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -98,6 +98,7 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE HydroDyn_InitInputType ! ======================= ! ========= HydroDyn_InitOutputType ======= @@ -224,6 +225,7 @@ MODULE HydroDyn_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE HydroDyn_ParameterType ! ======================= ! ========= HydroDyn_InputType ======= @@ -1963,6 +1965,7 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes END SUBROUTINE HydroDyn_CopyInitInput SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -2064,6 +2067,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! WaveFieldMod Re_BufSz = Re_BufSz + 1 ! PtfmLocationX Re_BufSz = Re_BufSz + 1 ! PtfmLocationY + Int_BufSz = Int_BufSz + 1 ! VisMeshes IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2169,6 +2173,8 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%PtfmLocationY Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2292,6 +2298,8 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = Re_Xferred + 1 OutData%PtfmLocationY = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackInitInput SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -8122,6 +8130,7 @@ SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%dx = SrcParamData%dx ENDIF DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%VisMeshes = SrcParamData%VisMeshes END SUBROUTINE HydroDyn_CopyParam SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -8421,6 +8430,7 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx END IF Int_BufSz = Int_BufSz + 1 ! Jac_ny + Int_BufSz = Int_BufSz + 1 ! VisMeshes IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -8897,6 +8907,8 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM END IF IntKiBuf(Int_Xferred) = InData%Jac_ny Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackParam SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9479,6 +9491,8 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E END IF OutData%Jac_ny = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackParam SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 0d834adfa5..35c1a11dbe 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1892,6 +1892,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%NMOutputs = InitInp%NMOutputs ! Number of members to output [ >=0 and <10] p%OutSwtch = InitInp%OutSwtch p%MSL2SWL = InitInp%MSL2SWL + p%VisMeshes = InitInp%VisMeshes ! visualization mesh for morison elements ALLOCATE ( p%MOutLst(p%NMOutputs), STAT = errStat ) IF ( errStat /= ErrID_None ) THEN @@ -2180,11 +2181,18 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In END IF + ! visualization Line2 mesh + if (p%VisMeshes) then + call VisMeshSetup(u,p,y,m,InitOut,ErrStat2,ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, 'Morison_Init' ) + if ( errStat >= AbortErrLev ) return + endif + ! We will call CalcOutput to compute the loads for the initial reference position ! Then we can use the computed load components in the Summary File ! NOTE: Morison module has no states, otherwise we could no do this. GJH call Morison_CalcOutput(0.0_DbKi, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) + IF ( errStat > AbortErrLev ) RETURN ! Write Summary information now that everything has been initialized. CALL WriteSummaryFile( InitInp%UnSum, InitInp%Gravity, InitInp%MSL2SWL, InitInp%WtrDpth, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & @@ -2198,6 +2206,106 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! END SUBROUTINE END SUBROUTINE Morison_Init +subroutine VisMeshSetup(u,p,y,m,InitOut,ErrStat,ErrMsg) + type(Morison_InputType), intent(inout) :: u + type(Morison_ParameterType), intent(in ) :: p + type(Morison_OutputType), intent(inout) :: y + type(Morison_MiscVarType), intent(inout) :: m + type(Morison_InitOutputType), intent(inout) :: InitOut + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + integer(IntKi) :: TotNodes ! total nodes in all elements (may differ from p%NNodes due to overlaps) + integer(IntKi) :: TotElems ! total number of elements + integer(IntKi) :: NdIdx, iMem, iNd, NdNum ! indexing + real(ReKi) :: NdPos(3),Pos1(3),Pos2(3) + real(R8Ki) :: MemberOrient(3,3) + real(R8Ki) :: Theta(3) ! Euler rotations + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'VisMeshSetup' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Total number of nodes = sum of all member nodes + ! Total number of elements = sum of all member elements + TotNodes=0 + TotElems=0 + do iMem=1,size(p%Members) + TotElems = TotElems + p%Members(iMem)%NElements + TotNodes = TotNodes + size(p%Members(iMem)%NodeIndx) + enddo + + ! Storage for the radius associated with each node + call AllocAry( InitOut%MorisonVisRad, TotNodes, 'MorisonVisRad', ErrStat2, ErrMsg2) + if (Failed()) return + + call MeshCreate( BlankMesh = y%VisMesh, & + IOS = COMPONENT_OUTPUT, & + Nnodes = TotNodes, & + ErrStat = ErrStat2, & + ErrMess = ErrMsg2, & + TranslationDisp = .TRUE., & + Orientation = .TRUE. ) + if (Failed()) return + + ! Position the nodes + NdNum=0 ! node number in y%VisMesh + do iMem=1,size(p%Members) + +!FIXME:MemberOrient This is not correct for non-circular or curved members + ! calculate an orientation using yaw-pitch-roll sequence with roll defined as zero (insufficient info) + Pos1=u%Mesh%Position(:,p%Members(iMem)%NodeIndx(1)) ! start node position of member + Pos2=u%Mesh%Position(:,p%Members(iMem)%NodeIndx(size(p%Members(iMem)%NodeIndx))) ! end node position of member + Theta(1) = 0.0_R8Ki ! roll (assumed since insufficient info) + Theta(2) = acos(real((Pos2(3)-Pos1(3))/norm2(Pos2-Pos1),R8Ki)) ! pitch + Theta(3) = atan2(real(Pos2(2)-Pos1(2),R8Ki),real(Pos2(1)-Pos1(1),R8Ki)) ! yaw + MemberOrient=EulerConstructZYX(Theta) ! yaw-pitch-roll sequence + + ! Set mesh postion, orientation, and radius + do iNd=1,size(p%Members(iMem)%NodeIndx) + NdNum=NdNum+1 ! node number in y%VisMesh + NdIdx = p%Members(iMem)%NodeIndx(iNd) ! node number in u%Mesh + NdPos = u%Mesh%Position(:,NdIdx) ! node position + call MeshPositionNode (y%VisMesh, NdNum, u%Mesh%Position(:,NdIdx), ErrStat2, ErrMsg2, Orient=MemberOrient) + if (Failed()) return + InitOut%MorisonVisRad(NdNum) = p%Members(iMem)%RMG(iNd) ! radius (including marine growth) for visualization + enddo + enddo + + ! make elements (line nodes start at 0 index, so N+1 total nodes) + NdNum=0 ! node number in y%VisMesh + do iMem=1,size(p%Members) + do iNd=1,size(p%Members(iMem)%NodeIndx) + NdNum=NdNum+1 ! node number in y%VisMesh + if (iNd==1) cycle + call MeshConstructElement ( Mesh = y%VisMesh, & + Xelement = ELEMENT_LINE2, & + P1=NdNum-1, P2=NdNum, & ! nodes to connect + errStat = ErrStat2, & + ErrMess = ErrMsg2 ) + if (Failed()) return + enddo + enddo + + ! commit the assembled mesh + call MeshCommit ( y%VisMesh, ErrStat2, ErrMsg2) + if (Failed()) return + + ! map the mesh to u%Mesh + call MeshMapCreate( u%Mesh, y%VisMesh, m%VisMeshMap, ErrStat2, ErrMsg2 ) + if (Failed()) return + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) then + ! call FailCleanup() + !endif + end function Failed +end subroutine VisMeshSetup SUBROUTINE RodrigMat(a, R, errStat, errMsg) @@ -3313,8 +3421,15 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL MrsnOut_WriteOutputs( p%UnOutFile, Time, y, p, errStat, errMsg ) END IF END IF - - + + + ! map the motion to the visulization mesh + if (p%VisMeshes) then + !FIXME: error handling is incorrect here (overwrites all previous errors/warnings) + call Transfer_Point_to_Line2( u%Mesh, y%VisMesh, m%VisMeshMap, ErrStat, ErrMsg ) + endif + + END SUBROUTINE Morison_CalcOutput subroutine LumpDistrHydroLoads( f_hydro, k_hat, dl, h_c, lumpedLoad ) diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 2943d32c35..c59db0b043 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -256,12 +256,13 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveDynP {:}{:} - - "" - typedef ^ ^ SiKi WaveVel {:}{:}{:} - - "" - typedef ^ ^ INTEGER nodeInWater {:}{:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - +typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # # # Define outputs from the initialization routine here: # #typedef ^ InitOutputType MeshType Mesh - - - "Unused?" - -#typedef ^ ^ SiKi Morison_Rad {:} - - "radius of node (for FAST visualization)" (m) +typedef ^ InitOutputType SiKi MorisonVisRad {:} - - "radius of node (for FAST visualization)" (m) typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "User-requested Output channel names" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - # @@ -310,6 +311,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi F_A_End {:}{:} - - "Lumped added mass loads at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi F_BF_End {:}{:} - - "" - typedef ^ ^ INTEGER LastIndWave - - - "Last time index used in the wave kinematics arrays" - +typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -349,6 +351,7 @@ typedef ^ ^ INTEGER typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - +typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # # # ..... Inputs .................................................................................................................... @@ -360,4 +363,5 @@ typedef ^ InputType MeshType # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType MeshType Mesh - - - "Loads on each node output mesh" - +typedef ^ ^ MeshType VisMesh - - - "Line mesh for visualization" - typedef ^ ^ ReKi WriteOutput {:} - - "" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 8f1ca39fd1..bfa9d65c53 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -319,10 +319,12 @@ MODULE Morison_Types REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] + LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE Morison_InitInputType ! ======================= ! ========= Morison_InitOutputType ======= TYPE, PUBLIC :: Morison_InitOutputType + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonVisRad !< radius of node (for FAST visualization) [(m)] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< User-requested Output channel names [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] END TYPE Morison_InitOutputType @@ -362,6 +364,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_A_End !< Lumped added mass loads at time t, which may not correspond to the WaveTime array of times [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_BF_End !< [-] INTEGER(IntKi) :: LastIndWave !< Last time index used in the wave kinematics arrays [-] + TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -400,6 +403,7 @@ MODULE Morison_Types CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] CHARACTER(ChanLen) :: Delim !< [-] + LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= @@ -410,6 +414,7 @@ MODULE Morison_Types ! ========= Morison_OutputType ======= TYPE, PUBLIC :: Morison_OutputType TYPE(MeshType) :: Mesh !< Loads on each node output mesh [-] + TYPE(MeshType) :: VisMesh !< Line mesh for visualization [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< [-] END TYPE Morison_OutputType ! ======================= @@ -6337,6 +6342,7 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%nodeInWater = SrcInitInputData%nodeInWater ENDIF + DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes END SUBROUTINE Morison_CopyInitInput SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -6813,6 +6819,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*2 ! nodeInWater upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater END IF + Int_BufSz = Int_BufSz + 1 ! VisMeshes IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -7491,6 +7498,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackInitInput SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -8358,6 +8367,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF + OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackInitInput SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -8375,6 +8386,18 @@ SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod ! ErrStat = ErrID_None ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%MorisonVisRad)) THEN + i1_l = LBOUND(SrcInitOutputData%MorisonVisRad,1) + i1_u = UBOUND(SrcInitOutputData%MorisonVisRad,1) + IF (.NOT. ALLOCATED(DstInitOutputData%MorisonVisRad)) THEN + ALLOCATE(DstInitOutputData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%MorisonVisRad = SrcInitOutputData%MorisonVisRad +ENDIF IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) @@ -8422,6 +8445,9 @@ SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCAT DEALLOCATEpointers_local = .true. END IF +IF (ALLOCATED(InitOutputData%MorisonVisRad)) THEN + DEALLOCATE(InitOutputData%MorisonVisRad) +ENDIF IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF @@ -8465,6 +8491,11 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! MorisonVisRad allocated yes/no + IF ( ALLOCATED(InData%MorisonVisRad) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MorisonVisRad upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MorisonVisRad) ! MorisonVisRad + END IF Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension @@ -8502,6 +8533,21 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%MorisonVisRad) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonVisRad,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonVisRad,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MorisonVisRad,1), UBOUND(InData%MorisonVisRad,1) + ReKiBuf(Re_Xferred) = InData%MorisonVisRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8565,6 +8611,24 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonVisRad not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MorisonVisRad)) DEALLOCATE(OutData%MorisonVisRad) + ALLOCATE(OutData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%MorisonVisRad,1), UBOUND(OutData%MorisonVisRad,1) + OutData%MorisonVisRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9156,7 +9220,7 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta END SUBROUTINE Morison_UnPackOtherState SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(Morison_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(Morison_MiscVarType), INTENT(INOUT) :: DstMiscData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -9338,6 +9402,9 @@ SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%F_BF_End = SrcMiscData%F_BF_End ENDIF DstMiscData%LastIndWave = SrcMiscData%LastIndWave + CALL NWTC_Library_Copymeshmaptype( SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyMisc SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -9401,6 +9468,8 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%F_BF_End)) THEN DEALLOCATE(MiscData%F_BF_End) ENDIF + CALL NWTC_Library_Destroymeshmaptype( MiscData%VisMeshMap, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyMisc SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -9518,6 +9587,23 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + SIZE(InData%F_BF_End) ! F_BF_End END IF Int_BufSz = Int_BufSz + 1 ! LastIndWave + Int_BufSz = Int_BufSz + 3 ! VisMeshMap: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%VisMeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! VisMeshMap + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisMeshMap + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisMeshMap + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisMeshMap + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -9798,6 +9884,34 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF IntKiBuf(Int_Xferred) = InData%LastIndWave Int_Xferred = Int_Xferred + 1 + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%VisMeshMap, ErrStat2, ErrMsg2, OnlySize ) ! VisMeshMap + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE Morison_PackMisc SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10129,6 +10243,46 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err END IF OutData%LastIndWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%VisMeshMap, ErrStat2, ErrMsg2 ) ! VisMeshMap + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE Morison_UnPackMisc SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -10400,6 +10554,7 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%OutFmt = SrcParamData%OutFmt DstParamData%OutSFmt = SrcParamData%OutSFmt DstParamData%Delim = SrcParamData%Delim + DstParamData%VisMeshes = SrcParamData%VisMeshes END SUBROUTINE Morison_CopyParam SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -10695,6 +10850,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim + Int_BufSz = Int_BufSz + 1 ! VisMeshes IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -11173,6 +11329,8 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackParam SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11751,6 +11909,8 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackParam SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -11993,6 +12153,9 @@ SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcOutputData%VisMesh, DstOutputData%VisMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN i1_l = LBOUND(SrcOutputData%WriteOutput,1) i1_u = UBOUND(SrcOutputData%WriteOutput,1) @@ -12030,6 +12193,8 @@ SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointer CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( OutputData%VisMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF @@ -12088,6 +12253,23 @@ SUBROUTINE Morison_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! VisMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%VisMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no IF ( ALLOCATED(InData%WriteOutput) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension @@ -12148,6 +12330,34 @@ SUBROUTINE Morison_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL MeshPack( InData%VisMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12232,6 +12442,46 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%VisMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12503,6 +12753,8 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%VisMesh, y2%VisMesh, tin, y_out%VisMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) @@ -12568,6 +12820,8 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%VisMesh, y2%VisMesh, y3%VisMesh, tin, y_out%VisMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index bbd5fc9328..c59dbcbbf0 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -194,6 +194,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er p%mu_kA = 0.0_DbKi p%mc = 1.0_DbKi p%cv = 200.0_DbKi + p%VisMeshes = InitInp%VisMeshes ! Visualization meshes requested by glue code DepthValue = "" ! Start off as empty string, to only be filled if MD setting is specified (otherwise InitInp%WtrDepth is used) ! DepthValue and InitInp%WtrDepth are processed later by setupBathymetry. WaterKinValue = "" @@ -931,8 +932,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body - else if ((let1 == "PINNED") .or. (let1 == "PIN")) then - m%RodList(l)%typeNum = 1 + else if ((let1 == "PINNED") .or. (let1 == "PIN")) then + m%RodList(l)%typeNum = 1 CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free @@ -2207,6 +2208,19 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! TODO: add feature for automatic water depth increase based on max anchor depth! + + !-------------------------------------------------- + ! initialize line visualization meshes if needed + if (p%VisMeshes) then + if (p%NLines > 0) then + call VisLinesMesh_Init(p,m,y,ErrStat2,ErrMsg2); if(Failed()) return + endif + if (p%NRods > 0) then + call VisRodsMesh_Init(p,m,y,ErrStat2,ErrMsg2); if(Failed()) return + endif + endif + + CONTAINS @@ -2251,7 +2265,7 @@ SUBROUTINE CheckError(ErrID,Msg) IF ( ErrStat >= AbortErrLev ) THEN IF (ALLOCATED(m%CpldConIs )) DEALLOCATE(m%CpldConIs ) - IF (ALLOCATED(m%FreeConIs )) DEALLOCATE(m%FreeConIs ) + IF (ALLOCATED(m%FreeConIs )) DEALLOCATE(m%FreeConIs ) IF (ALLOCATED(m%LineStateIs1 )) DEALLOCATE(m%LineStateIs1 ) IF (ALLOCATED(m%LineStateIsN )) DEALLOCATE(m%LineStateIsN ) IF (ALLOCATED(m%ConStateIs1 )) DEALLOCATE(m%ConStateIs1 ) @@ -2606,6 +2620,20 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) ! IF ( ErrStat >= AbortErrLev ) RETURN + !-------------------------------------------------- + ! update line visualization meshes if needed + if (p%VisMeshes) then + if (p%NLines > 0) then + call VisLinesMesh_Update(p,m,y,ErrStat2,ErrMsg2) + call CheckError(ErrStat2, ErrMsg2) + if ( ErrStat >= AbortErrLev ) return + endif + if (p%NRods > 0) then + call VisRodsMesh_Update(p,m,y,ErrStat2,ErrMsg2) + call CheckError(ErrStat2, ErrMsg2) + if ( ErrStat >= AbortErrLev ) return + endif + endif CONTAINS diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 index 1d6b216424..26985b4279 100644 --- a/modules/moordyn/src/MoorDyn_Line.f90 +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -39,7 +39,8 @@ MODULE MoorDyn_Line PUBLIC :: Line_GetEndStuff PUBLIC :: Line_GetEndSegmentInfo PUBLIC :: Line_SetEndOrientation - + public :: VisLinesMesh_Init + public :: VisLinesMesh_Update CONTAINS @@ -1631,5 +1632,94 @@ SUBROUTINE Line_SetEndOrientation(Line, qin, topOfLine, rodEndB) END SUBROUTINE Line_SetEndOrientation !-------------------------------------------------------------- + subroutine VisLinesMesh_Init(p,m,y,ErrStat,ErrMsg) + type(MD_ParameterType), intent(in ) :: p + type(MD_MiscVarType), intent(in ) :: m + type(MD_OutputType), intent(inout) :: y + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i,l + character(*), parameter :: RoutineName = 'VisLinesMesh_Init' + + ErrStat = ErrID_None + ErrMsg = '' + + ! allocate line2 mesh for all lines + allocate (y%VisLinesMesh(p%NLines), STAT=ErrStat2); if (Failed0('visualization mesh for lines')) return + + ! Initialize mesh for each line (line nodes start at 0 index, so N+1 total nodes) + do l=1,p%NLines + CALL MeshCreate( BlankMesh = y%VisLinesMesh(l), & + NNodes = m%LineList(l)%N+1, & + IOS = COMPONENT_OUTPUT, & + TranslationDisp = .true., & + ErrStat=ErrStat2, ErrMess=ErrMsg2) + if (Failed()) return + + ! Internal nodes (line nodes start at 0 index) + do i = 0,m%LineList(l)%N + call MeshPositionNode ( y%VisLinesMesh(l), i+1, real(m%LineList(l)%r(:,I),ReKi), ErrStat2, ErrMsg2 ) + if (Failed()) return + enddo + + ! make elements (line nodes start at 0 index, so N+1 total nodes) + do i = 2,m%LineList(l)%N+1 + call MeshConstructElement ( Mesh = y%VisLinesMesh(l) & + , Xelement = ELEMENT_LINE2 & + , P1 = i-1 & ! node1 number + , P2 = i & ! node2 number + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + if (Failed()) return + enddo + + ! Commit mesh + call MeshCommit ( y%VisLinesMesh(l), ErrStat2, ErrMsg2 ) + if (Failed()) return + enddo + contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + end function Failed0 + end subroutine VisLinesMesh_Init + + + + subroutine VisLinesMesh_Update(p,m,y,ErrStat,ErrMsg) + type(MD_ParameterType), intent(in ) :: p + type(MD_MiscVarType), intent(in ) :: m + type(MD_OutputType), intent(inout) :: y + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i,l + character(*), parameter :: RoutineName = 'VisLinesMesh_Update' + + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize mesh for each line (line nodes start at 0 index, so N+1 total nodes) + do l=1,p%NLines + ! Update node positions nodes (line nodes start at 0 index) + do i = 0,m%LineList(l)%N + y%VisLinesMesh(l)%TranslationDisp(:,i+1) = real(m%LineList(l)%r(:,I),ReKi) - y%VisLinesMesh(l)%Position(:,i+1) + enddo + enddo + end subroutine VisLinesMesh_Update + + END MODULE MoorDyn_Line diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index a3ed6ef2b9..6308509807 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -34,6 +34,7 @@ typedef ^ ^ FileInfoType PassedPrimaryInputData typedef ^ ^ LOGICAL Echo - "" - "echo parameter - do we want to echo the header line describing the input file?" typedef ^ ^ CHARACTER(ChanLen) OutList {:} "" - "string containing list of output channels requested in input file" typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical VisMeshes - .FALSE. - "Glue code requesting visualization meshes" - #typedef ^ ^ DbKi UGrid {:}{:}{:} - - "water velocities time series at each grid point" - #typedef ^ ^ DbKi UdGrid {:}{:}{:} - - "water accelerations time series at each grid point" - @@ -282,6 +283,8 @@ typedef ^ ^ IntKi OType - typedef ^ ^ IntKi NodeID - - - "node number if OType=0. 0=anchor, -1=N=Fairlead" typedef ^ ^ IntKi ObjID - - - "number of Connect or Line object" +## ============================== Visualization data storage for diameter ============================================================================================================================ +typedef ^ VisDiam SiKi Diam {:} - - "Diameter for visualization" - ## ============================== Define Initialization outputs here: ================================================================================================================================ typedef ^ InitOutputType CHARACTER(ChanLen) writeOutputHdr {:} "" - "first line output file contents: output variable names" @@ -422,6 +425,8 @@ typedef ^ ^ R8Ki dx {:} typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - typedef ^ ^ Integer Jac_nx - - - "number of continuous states in jacobian matrix" - typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} - - "Mapping array from index of dX array to corresponding state index" - +typedef ^ ^ Logical VisMeshes - - - "Using visualization meshes as requested by glue code" - +typedef ^ ^ VisDiam VisRodsDiam {:} - - "Diameters for visualization of rods" - # ============================== Inputs ============================================================================================================================================ @@ -439,3 +444,7 @@ typedef ^ OutputType MeshType CoupledLoads {:} typedef ^ ^ ReKi WriteOutput {:} - - "output vector returned to glue code" "" # should CoupledLoads be an array? #typedef ^ ^ DbKi rAll {:}{:} - - "Mesh of all point positions: bodies, rods, points, line internal nodes" - +typedef ^ ^ MeshType VisLinesMesh {:} - - "Line2 mesh for visualizing mooring lines" - +typedef ^ ^ MeshType VisRodsMesh {:} - - "Line2 mesh for visualizing mooring rods" - +typedef ^ ^ MeshType VisBodiesMesh {:} - - "Point mesh for visualizing mooring bodies" - +typedef ^ ^ MeshType VisAnchsMesh {:} - - "Point mesh for visualizing mooring anchors" - diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index 26bd00c96b..f65ed8222c 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -42,9 +42,11 @@ MODULE MoorDyn_Rod PUBLIC :: Rod_GetNetForceAndMass PUBLIC :: Rod_AddLine PUBLIC :: Rod_RemoveLine + public :: VisRodsMesh_Init + public :: VisRodsMesh_Update + - CONTAINS @@ -1190,5 +1192,102 @@ END SUBROUTINE Rod_RemoveLine + subroutine VisRodsMesh_Init(p,m,y,ErrStat,ErrMsg) + type(MD_ParameterType), intent(inout) :: p + type(MD_MiscVarType), intent(in ) :: m + type(MD_OutputType), intent(inout) :: y + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i,l + character(*), parameter :: RoutineName = 'VisRodsMesh_Init' + + ErrStat = ErrID_None + ErrMsg = '' + + ! allocate line2 mesh for all lines + allocate (y%VisRodsMesh(p%NRods), STAT=ErrStat2); if (Failed0('visualization mesh for lines')) return + allocate (p%VisRodsDiam(p%NRods), STAT=ErrStat2); if (Failed0('visualization mesh for lines')) return + + ! Initialize mesh for each line (line nodes start at 0 index, so N+1 total nodes) + do l=1,p%NRods + CALL MeshCreate( BlankMesh = y%VisRodsMesh(l), & + NNodes = m%RodList(l)%N+1, & + IOS = COMPONENT_OUTPUT, & + TranslationDisp = .true., & + Orientation = .true., & + ErrStat=ErrStat2, ErrMess=ErrMsg2) + if (Failed()) return + + ! Internal nodes (line nodes start at 0 index) + do i = 0,m%RodList(l)%N + call MeshPositionNode ( y%VisRodsMesh(l), i+1, real(m%RodList(l)%r(:,I),ReKi), ErrStat2, ErrMsg2, Orient=real(m%RodList(l)%OrMat,R8Ki)) + if (Failed()) return + enddo + + ! make elements (line nodes start at 0 index, so N+1 total nodes) + do i = 2,m%RodList(l)%N+1 + call MeshConstructElement ( Mesh = y%VisRodsMesh(l) & + , Xelement = ELEMENT_LINE2 & + , P1 = i-1 & ! node1 number + , P2 = i & ! node2 number + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + if (Failed()) return + enddo + + ! Commit mesh + call MeshCommit ( y%VisRodsMesh(l), ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Set rod diameter for visualization + call AllocAry(p%VisRodsDiam(l)%Diam,m%RodList(l)%N+1,'',ErrStat2,ErrMsg2) + if (Failed()) return + p%VisRodsDiam(l)%Diam=real(m%RodTypeList(m%RodList(l)%PropsIdNum)%d,SiKi) + enddo + contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + end function Failed0 + end subroutine VisRodsMesh_Init + + + + subroutine VisRodsMesh_Update(p,m,y,ErrStat,ErrMsg) + type(MD_ParameterType), intent(in ) :: p + type(MD_MiscVarType), intent(in ) :: m + type(MD_OutputType), intent(inout) :: y + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i,l + character(*), parameter :: RoutineName = 'VisRodsMesh_Update' + + ErrStat = ErrID_None + ErrMsg = '' + + do l=1,p%NRods + ! Update rod positions/orientations + do i = 0,m%RodList(l)%N + y%VisRodsMesh(l)%TranslationDisp(:,i+1) = real(m%RodList(l)%r(:,I),ReKi) - y%VisRodsMesh(l)%Position(:,i+1) + y%VisRodsMesh(l)%Orientation(:,:,i+1) = real(m%RodList(l)%OrMat,R8Ki) + enddo + enddo + end subroutine VisRodsMesh_Update + + + END MODULE MoorDyn_Rod diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index b35edada02..deab24f1f7 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -57,6 +57,7 @@ MODULE MoorDyn_Types LOGICAL :: Echo !< echo parameter - do we want to echo the header line describing the input file? [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + LOGICAL :: VisMeshes = .FALSE. !< Glue code requesting visualization meshes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WavePDyn !< [-] @@ -306,6 +307,11 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: ObjID !< number of Connect or Line object [-] END TYPE MD_OutParmType ! ======================= +! ========= VisDiam ======= + TYPE, PUBLIC :: VisDiam + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Diam !< Diameter for visualization [-] + END TYPE VisDiam +! ======================= ! ========= MD_InitOutputType ======= TYPE, PUBLIC :: MD_InitOutputType CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] @@ -451,6 +457,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] INTEGER(IntKi) :: Jac_nx !< number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] + LOGICAL :: VisMeshes !< Using visualization meshes as requested by glue code [-] + TYPE(VisDiam) , DIMENSION(:), ALLOCATABLE :: VisRodsDiam !< Diameters for visualization of rods [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= @@ -464,6 +472,10 @@ MODULE MoorDyn_Types TYPE, PUBLIC :: MD_OutputType TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: CoupledLoads !< array of point meshes for mooring reaction forces (and moments) at coupling points [[N]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output vector returned to glue code [] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: VisLinesMesh !< Line2 mesh for visualizing mooring lines [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: VisRodsMesh !< Line2 mesh for visualizing mooring rods [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: VisBodiesMesh !< Point mesh for visualizing mooring bodies [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: VisAnchsMesh !< Point mesh for visualizing mooring anchors [-] END TYPE MD_OutputType ! ======================= CONTAINS @@ -700,6 +712,7 @@ SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%OutList = SrcInitInputData%OutList ENDIF DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes IF (ALLOCATED(SrcInitInputData%WaveVel)) THEN i1_l = LBOUND(SrcInitInputData%WaveVel,1) i1_u = UBOUND(SrcInitInputData%WaveVel,1) @@ -901,6 +914,7 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList END IF Int_BufSz = Int_BufSz + 1 ! Linearize + Int_BufSz = Int_BufSz + 1 ! VisMeshes Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no IF ( ALLOCATED(InData%WaveVel) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension @@ -1062,6 +1076,8 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1328,6 +1344,8 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err END IF OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) Int_Xferred = Int_Xferred + 1 + OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6876,6 +6894,192 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_UnPackOutParmType + SUBROUTINE MD_CopyVisDiam( SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(VisDiam), INTENT(IN) :: SrcVisDiamData + TYPE(VisDiam), INTENT(INOUT) :: DstVisDiamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyVisDiam' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcVisDiamData%Diam)) THEN + i1_l = LBOUND(SrcVisDiamData%Diam,1) + i1_u = UBOUND(SrcVisDiamData%Diam,1) + IF (.NOT. ALLOCATED(DstVisDiamData%Diam)) THEN + ALLOCATE(DstVisDiamData%Diam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVisDiamData%Diam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVisDiamData%Diam = SrcVisDiamData%Diam +ENDIF + END SUBROUTINE MD_CopyVisDiam + + SUBROUTINE MD_DestroyVisDiam( VisDiamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(VisDiam), INTENT(INOUT) :: VisDiamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyVisDiam' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(VisDiamData%Diam)) THEN + DEALLOCATE(VisDiamData%Diam) +ENDIF + END SUBROUTINE MD_DestroyVisDiam + + SUBROUTINE MD_PackVisDiam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(VisDiam), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackVisDiam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Diam allocated yes/no + IF ( ALLOCATED(InData%Diam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Diam upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Diam) ! Diam + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%Diam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Diam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Diam,1), UBOUND(InData%Diam,1) + ReKiBuf(Re_Xferred) = InData%Diam(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackVisDiam + + SUBROUTINE MD_UnPackVisDiam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(VisDiam), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackVisDiam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Diam)) DEALLOCATE(OutData%Diam) + ALLOCATE(OutData%Diam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Diam,1), UBOUND(OutData%Diam,1) + OutData%Diam(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_UnPackVisDiam + SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(MD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -11197,6 +11401,23 @@ SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF END IF DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx +ENDIF + DstParamData%VisMeshes = SrcParamData%VisMeshes +IF (ALLOCATED(SrcParamData%VisRodsDiam)) THEN + i1_l = LBOUND(SrcParamData%VisRodsDiam,1) + i1_u = UBOUND(SrcParamData%VisRodsDiam,1) + IF (.NOT. ALLOCATED(DstParamData%VisRodsDiam)) THEN + ALLOCATE(DstParamData%VisRodsDiam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%VisRodsDiam,1), UBOUND(SrcParamData%VisRodsDiam,1) + CALL MD_Copyvisdiam( SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF END SUBROUTINE MD_CopyParam @@ -11293,6 +11514,13 @@ SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%dxIdx_map2_xStateIdx)) THEN DEALLOCATE(ParamData%dxIdx_map2_xStateIdx) +ENDIF +IF (ALLOCATED(ParamData%VisRodsDiam)) THEN +DO i1 = LBOUND(ParamData%VisRodsDiam,1), UBOUND(ParamData%VisRodsDiam,1) + CALL MD_Destroyvisdiam( ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%VisRodsDiam) ENDIF END SUBROUTINE MD_DestroyParam @@ -11510,6 +11738,30 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IF ( ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN Int_BufSz = Int_BufSz + 2*1 ! dxIdx_map2_xStateIdx upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%dxIdx_map2_xStateIdx) ! dxIdx_map2_xStateIdx + END IF + Int_BufSz = Int_BufSz + 1 ! VisMeshes + Int_BufSz = Int_BufSz + 1 ! VisRodsDiam allocated yes/no + IF ( ALLOCATED(InData%VisRodsDiam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VisRodsDiam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VisRodsDiam,1), UBOUND(InData%VisRodsDiam,1) + Int_BufSz = Int_BufSz + 3 ! VisRodsDiam: size of buffers for each call to pack subtype + CALL MD_Packvisdiam( Re_Buf, Db_Buf, Int_Buf, InData%VisRodsDiam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VisRodsDiam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisRodsDiam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisRodsDiam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisRodsDiam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -12131,6 +12383,49 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf(Int_Xferred) = InData%dxIdx_map2_xStateIdx(i1) Int_Xferred = Int_Xferred + 1 END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%VisRodsDiam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VisRodsDiam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisRodsDiam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VisRodsDiam,1), UBOUND(InData%VisRodsDiam,1) + CALL MD_Packvisdiam( Re_Buf, Db_Buf, Int_Buf, InData%VisRodsDiam(i1), ErrStat2, ErrMsg2, OnlySize ) ! VisRodsDiam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF END SUBROUTINE MD_PackParam @@ -12839,46 +13134,104 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 END DO END IF - END SUBROUTINE MD_UnPackParam - - SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%CoupledKinematics)) THEN - i1_l = LBOUND(SrcInputData%CoupledKinematics,1) - i1_u = UBOUND(SrcInputData%CoupledKinematics,1) - IF (.NOT. ALLOCATED(DstInputData%CoupledKinematics)) THEN - ALLOCATE(DstInputData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) + OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VisRodsDiam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VisRodsDiam)) DEALLOCATE(OutData%VisRodsDiam) + ALLOCATE(OutData%VisRodsDiam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - END IF - DO i1 = LBOUND(SrcInputData%CoupledKinematics,1), UBOUND(SrcInputData%CoupledKinematics,1) - CALL MeshCopy( SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%DeltaL)) THEN - i1_l = LBOUND(SrcInputData%DeltaL,1) - i1_u = UBOUND(SrcInputData%DeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaL)) THEN - ALLOCATE(DstInputData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg,RoutineName) + DO i1 = LBOUND(OutData%VisRodsDiam,1), UBOUND(OutData%VisRodsDiam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackvisdiam( Re_Buf, Db_Buf, Int_Buf, OutData%VisRodsDiam(i1), ErrStat2, ErrMsg2 ) ! VisRodsDiam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + END SUBROUTINE MD_UnPackParam + + SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_InputType), INTENT(INOUT) :: SrcInputData + TYPE(MD_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInputData%CoupledKinematics)) THEN + i1_l = LBOUND(SrcInputData%CoupledKinematics,1) + i1_u = UBOUND(SrcInputData%CoupledKinematics,1) + IF (.NOT. ALLOCATED(DstInputData%CoupledKinematics)) THEN + ALLOCATE(DstInputData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputData%CoupledKinematics,1), UBOUND(SrcInputData%CoupledKinematics,1) + CALL MeshCopy( SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcInputData%DeltaL)) THEN + i1_l = LBOUND(SrcInputData%DeltaL,1) + i1_u = UBOUND(SrcInputData%DeltaL,1) + IF (.NOT. ALLOCATED(DstInputData%DeltaL)) THEN + ALLOCATE(DstInputData%DeltaL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF @@ -13266,6 +13619,70 @@ SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput +ENDIF +IF (ALLOCATED(SrcOutputData%VisLinesMesh)) THEN + i1_l = LBOUND(SrcOutputData%VisLinesMesh,1) + i1_u = UBOUND(SrcOutputData%VisLinesMesh,1) + IF (.NOT. ALLOCATED(DstOutputData%VisLinesMesh)) THEN + ALLOCATE(DstOutputData%VisLinesMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%VisLinesMesh,1), UBOUND(SrcOutputData%VisLinesMesh,1) + CALL MeshCopy( SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcOutputData%VisRodsMesh)) THEN + i1_l = LBOUND(SrcOutputData%VisRodsMesh,1) + i1_u = UBOUND(SrcOutputData%VisRodsMesh,1) + IF (.NOT. ALLOCATED(DstOutputData%VisRodsMesh)) THEN + ALLOCATE(DstOutputData%VisRodsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%VisRodsMesh,1), UBOUND(SrcOutputData%VisRodsMesh,1) + CALL MeshCopy( SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcOutputData%VisBodiesMesh)) THEN + i1_l = LBOUND(SrcOutputData%VisBodiesMesh,1) + i1_u = UBOUND(SrcOutputData%VisBodiesMesh,1) + IF (.NOT. ALLOCATED(DstOutputData%VisBodiesMesh)) THEN + ALLOCATE(DstOutputData%VisBodiesMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%VisBodiesMesh,1), UBOUND(SrcOutputData%VisBodiesMesh,1) + CALL MeshCopy( SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcOutputData%VisAnchsMesh)) THEN + i1_l = LBOUND(SrcOutputData%VisAnchsMesh,1) + i1_u = UBOUND(SrcOutputData%VisAnchsMesh,1) + IF (.NOT. ALLOCATED(DstOutputData%VisAnchsMesh)) THEN + ALLOCATE(DstOutputData%VisAnchsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%VisAnchsMesh,1), UBOUND(SrcOutputData%VisAnchsMesh,1) + CALL MeshCopy( SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF END SUBROUTINE MD_CopyOutput @@ -13299,6 +13716,34 @@ SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) +ENDIF +IF (ALLOCATED(OutputData%VisLinesMesh)) THEN +DO i1 = LBOUND(OutputData%VisLinesMesh,1), UBOUND(OutputData%VisLinesMesh,1) + CALL MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OutputData%VisLinesMesh) +ENDIF +IF (ALLOCATED(OutputData%VisRodsMesh)) THEN +DO i1 = LBOUND(OutputData%VisRodsMesh,1), UBOUND(OutputData%VisRodsMesh,1) + CALL MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OutputData%VisRodsMesh) +ENDIF +IF (ALLOCATED(OutputData%VisBodiesMesh)) THEN +DO i1 = LBOUND(OutputData%VisBodiesMesh,1), UBOUND(OutputData%VisBodiesMesh,1) + CALL MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OutputData%VisBodiesMesh) +ENDIF +IF (ALLOCATED(OutputData%VisAnchsMesh)) THEN +DO i1 = LBOUND(OutputData%VisAnchsMesh,1), UBOUND(OutputData%VisAnchsMesh,1) + CALL MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OutputData%VisAnchsMesh) ENDIF END SUBROUTINE MD_DestroyOutput @@ -13366,6 +13811,98 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput END IF + Int_BufSz = Int_BufSz + 1 ! VisLinesMesh allocated yes/no + IF ( ALLOCATED(InData%VisLinesMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VisLinesMesh upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VisLinesMesh,1), UBOUND(InData%VisLinesMesh,1) + Int_BufSz = Int_BufSz + 3 ! VisLinesMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%VisLinesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisLinesMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisLinesMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisLinesMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisLinesMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! VisRodsMesh allocated yes/no + IF ( ALLOCATED(InData%VisRodsMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VisRodsMesh upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VisRodsMesh,1), UBOUND(InData%VisRodsMesh,1) + Int_BufSz = Int_BufSz + 3 ! VisRodsMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%VisRodsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisRodsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisRodsMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisRodsMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisRodsMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! VisBodiesMesh allocated yes/no + IF ( ALLOCATED(InData%VisBodiesMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VisBodiesMesh upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VisBodiesMesh,1), UBOUND(InData%VisBodiesMesh,1) + Int_BufSz = Int_BufSz + 3 ! VisBodiesMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%VisBodiesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisBodiesMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisBodiesMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisBodiesMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisBodiesMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! VisAnchsMesh allocated yes/no + IF ( ALLOCATED(InData%VisAnchsMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VisAnchsMesh upper/lower bounds for each dimension + DO i1 = LBOUND(InData%VisAnchsMesh,1), UBOUND(InData%VisAnchsMesh,1) + Int_BufSz = Int_BufSz + 3 ! VisAnchsMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%VisAnchsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisAnchsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VisAnchsMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VisAnchsMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VisAnchsMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -13449,49 +13986,213 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Re_Xferred = Re_Xferred + 1 END DO END IF - END SUBROUTINE MD_PackOutput + IF ( .NOT. ALLOCATED(InData%VisLinesMesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VisLinesMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisLinesMesh,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledLoads not allocated + DO i1 = LBOUND(InData%VisLinesMesh,1), UBOUND(InData%VisLinesMesh,1) + CALL MeshPack( InData%VisLinesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisLinesMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VisRodsMesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%VisRodsMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisRodsMesh,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CoupledLoads)) DEALLOCATE(OutData%CoupledLoads) - ALLOCATE(OutData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledLoads,1), UBOUND(OutData%CoupledLoads,1) + + DO i1 = LBOUND(InData%VisRodsMesh,1), UBOUND(InData%VisRodsMesh,1) + CALL MeshPack( InData%VisRodsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisRodsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VisBodiesMesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VisBodiesMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisBodiesMesh,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VisBodiesMesh,1), UBOUND(InData%VisBodiesMesh,1) + CALL MeshPack( InData%VisBodiesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisBodiesMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%VisAnchsMesh) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VisAnchsMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisAnchsMesh,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VisAnchsMesh,1), UBOUND(InData%VisAnchsMesh,1) + CALL MeshPack( InData%VisAnchsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisAnchsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + END SUBROUTINE MD_PackOutput + + SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledLoads not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CoupledLoads)) DEALLOCATE(OutData%CoupledLoads) + ALLOCATE(OutData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CoupledLoads,1), UBOUND(OutData%CoupledLoads,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -13552,6 +14253,230 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VisLinesMesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VisLinesMesh)) DEALLOCATE(OutData%VisLinesMesh) + ALLOCATE(OutData%VisLinesMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VisLinesMesh,1), UBOUND(OutData%VisLinesMesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%VisLinesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisLinesMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VisRodsMesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VisRodsMesh)) DEALLOCATE(OutData%VisRodsMesh) + ALLOCATE(OutData%VisRodsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VisRodsMesh,1), UBOUND(OutData%VisRodsMesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%VisRodsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisRodsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VisBodiesMesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VisBodiesMesh)) DEALLOCATE(OutData%VisBodiesMesh) + ALLOCATE(OutData%VisBodiesMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VisBodiesMesh,1), UBOUND(OutData%VisBodiesMesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%VisBodiesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisBodiesMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VisAnchsMesh not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VisAnchsMesh)) DEALLOCATE(OutData%VisAnchsMesh) + ALLOCATE(OutData%VisAnchsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VisAnchsMesh,1), UBOUND(OutData%VisAnchsMesh,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%VisAnchsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisAnchsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF END SUBROUTINE MD_UnPackOutput @@ -13852,6 +14777,30 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN + DO i1 = LBOUND(y_out%VisLinesMesh,1),UBOUND(y_out%VisLinesMesh,1) + CALL MeshExtrapInterp1(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN + DO i1 = LBOUND(y_out%VisRodsMesh,1),UBOUND(y_out%VisRodsMesh,1) + CALL MeshExtrapInterp1(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN + DO i1 = LBOUND(y_out%VisBodiesMesh,1),UBOUND(y_out%VisBodiesMesh,1) + CALL MeshExtrapInterp1(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN + DO i1 = LBOUND(y_out%VisAnchsMesh,1),UBOUND(y_out%VisAnchsMesh,1) + CALL MeshExtrapInterp1(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp1 @@ -13922,6 +14871,30 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN + DO i1 = LBOUND(y_out%VisLinesMesh,1),UBOUND(y_out%VisLinesMesh,1) + CALL MeshExtrapInterp2(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), y3%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN + DO i1 = LBOUND(y_out%VisRodsMesh,1),UBOUND(y_out%VisRodsMesh,1) + CALL MeshExtrapInterp2(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), y3%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN + DO i1 = LBOUND(y_out%VisBodiesMesh,1),UBOUND(y_out%VisBodiesMesh,1) + CALL MeshExtrapInterp2(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), y3%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN + DO i1 = LBOUND(y_out%VisAnchsMesh,1),UBOUND(y_out%VisAnchsMesh,1) + CALL MeshExtrapInterp2(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), y3%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp2 diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index f1b4e5504f..b869f5202f 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -69,7 +69,7 @@ typedef ^ FAST_VTK_SurfaceType IntKi NWaveElevPts {2} - - "number of points for typedef ^ FAST_VTK_SurfaceType SiKi WaveElevXY {:}{:} - - "X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveElevXY; first dimension is time step; second dimension is point number" "m,-" typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m -typedef ^ FAST_VTK_SurfaceType SiKi MorisonRad {:} - - "radius of each Morison node" m +typedef ^ FAST_VTK_SurfaceType SiKi MorisonVisRad {:} - - "radius of each Morison node" m typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) CheckpointRoot - - - "name of the checkpoint file written by FAST when linearization data was produced" diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2f99a720cf..9129d0555d 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -783,6 +783,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%TMax = p_FAST%TMax Init%InData_HD%hasIce = p_FAST%CompIce /= Module_None Init%InData_HD%Linearize = p_FAST%Linearize + if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. ! these values support wave field handling Init%InData_HD%WaveFieldMod = p_FAST%WaveFieldMod @@ -1011,7 +1012,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) Init%InData_MD%Linearize = p_FAST%Linearize - + if (p_FAST%WrVTK /= VTK_None) Init%InData_MD%VisMeshes=.true. 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 ) @@ -3339,6 +3340,9 @@ SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrS if (ErrStat >= AbortErrLev) return Width = p_FAST%VTK_Surface%GroundRad * VTK_GroundFactor +!FIXME:ADP -- change test after merging to dev branch to compare to MHK_None + ! adjust to larger surface area for MHK since MHK turbines tend to be small compared to the platform + if (p_FAST%MHK /= 0_IntKi) Width = Width * 5.0_SiKi dx = Width / (p_FAST%VTK_surface%NWaveElevPts(1) - 1) dy = Width / (p_FAST%VTK_surface%NWaveElevPts(2) - 1) @@ -3420,6 +3424,9 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H RefPoint = p_FAST%TurbinePos if (p_FAST%CompHydro == MODULE_HD) then RefLengths = p_FAST%VTK_Surface%GroundRad*VTK_GroundFactor/2.0_SiKi +!FIXME: after merge to dev, change this test to use MHK_None + ! adjust to larger ground area for MHK since MHK turbines tend to be small compared to the platform + if (p_FAST%MHK /= 0_IntKi) RefLengths = RefLengths*4.0_SiKi ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%WtrDpth @@ -3556,10 +3563,8 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H ! 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) - + IF ( HD%y%Morison%VisMesh%Committed ) THEN + call move_alloc(InitOutData_HD%Morison%MorisonVisRad, p_FAST%VTK_Surface%MorisonVisRad) END IF END SUBROUTINE SetVTKParameters @@ -5649,7 +5654,10 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H 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 ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonPt', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%Mesh ) + if (HD%y%Morison%VisMesh%Committed) then + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%VisMesh, 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 ) + endif END IF ! SubDyn @@ -5677,6 +5685,20 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H 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 + if (allocated(MD%y%VisLinesMesh)) then + do j=1,size(MD%y%VisLinesMesh) + if (MD%y%VisLinesMesh(j)%Committed) then + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + enddo + endif + if (allocated(MD%y%VisRodsMesh)) then + do j=1,size(MD%y%VisRodsMesh) + if (MD%y%VisRodsMesh(j)%Committed) then + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisRodsMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + enddo + endif ! FEAMooring ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN @@ -5739,7 +5761,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, 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) :: NumBl, k, j INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_BasicMeshes' @@ -5799,16 +5821,35 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, 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, & + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonPt', y_FAST%VTK_count, & p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%Morison%Mesh ) + if (HD%y%Morison%VisMesh%Committed) then + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%VisMesh, 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 ) + endif 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 ) + if ( p_FAST%CompMooring == Module_MD ) then + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + if (allocated(MD%y%VisLinesMesh)) then + do j=1,size(MD%y%VisLinesMesh) + if (MD%y%VisLinesMesh(j)%Committed) then + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + enddo + endif + if (allocated(MD%y%VisRodsMesh)) then + do j=1,size(MD%y%VisRodsMesh) + if (MD%y%VisRodsMesh(j)%Committed) then + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisRodsMesh(j), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(j)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + enddo + endif + endif ! 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 @@ -5843,7 +5884,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: NumBl, k, l INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' @@ -5916,26 +5957,38 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! 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 + + +! HydroDyn + IF ( HD%y%Morison%VisMesh%Committed ) THEN + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%y%Morison%VisMesh, 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%MorisonVisRad ) + 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 ) + if ( p_FAST%CompMooring == Module_MD ) THEN + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) + if (allocated(MD%y%VisLinesMesh)) then + do l=1,size(MD%y%VisLinesMesh) + if (MD%y%VisLinesMesh(l)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(l)), y_FAST%VTK_count, p_FAST%VTK_fields, & + ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) + endif + enddo + endif + if (allocated(MD%y%VisRodsMesh)) then + do l=1,size(MD%y%VisRodsMesh) + if (MD%y%VisRodsMesh(l)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(l))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & + ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(l)%Diam ) + endif + enddo + endif + endif ! 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 @@ -6142,8 +6195,8 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, 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_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 @@ -6225,8 +6278,8 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ 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_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 ) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index a3f9d9a9dd..fc8eac4b86 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -88,7 +88,7 @@ MODULE FAST_Types REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< wave elevation at WaveElevXY; first dimension is time step; second dimension is point number [m,-] TYPE(FAST_VTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [m] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonRad !< radius of each Morison node [m] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonVisRad !< radius of each Morison node [m] END TYPE FAST_VTK_SurfaceType ! ======================= ! ========= FAST_VTK_ModeShapeType ======= @@ -1084,17 +1084,17 @@ SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeD IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%MorisonRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%MorisonRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%MorisonRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%MorisonRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%MorisonRad(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcVTK_SurfaceTypeData%MorisonVisRad)) THEN + i1_l = LBOUND(SrcVTK_SurfaceTypeData%MorisonVisRad,1) + i1_u = UBOUND(SrcVTK_SurfaceTypeData%MorisonVisRad,1) + IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%MorisonVisRad)) THEN + ALLOCATE(DstVTK_SurfaceTypeData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonRad.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstVTK_SurfaceTypeData%MorisonRad = SrcVTK_SurfaceTypeData%MorisonRad + DstVTK_SurfaceTypeData%MorisonVisRad = SrcVTK_SurfaceTypeData%MorisonVisRad ENDIF END SUBROUTINE FAST_CopyVTK_SurfaceType @@ -1135,8 +1135,8 @@ SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg, DE ENDDO DEALLOCATE(VTK_SurfaceTypeData%BladeShape) ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%MorisonRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%MorisonRad) +IF (ALLOCATED(VTK_SurfaceTypeData%MorisonVisRad)) THEN + DEALLOCATE(VTK_SurfaceTypeData%MorisonVisRad) ENDIF END SUBROUTINE FAST_DestroyVTK_SurfaceType @@ -1219,10 +1219,10 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! MorisonRad allocated yes/no - IF ( ALLOCATED(InData%MorisonRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonRad) ! MorisonRad + Int_BufSz = Int_BufSz + 1 ! MorisonVisRad allocated yes/no + IF ( ALLOCATED(InData%MorisonVisRad) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MorisonVisRad upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MorisonVisRad) ! MorisonVisRad END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -1363,18 +1363,18 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%MorisonRad) ) THEN + IF ( .NOT. ALLOCATED(InData%MorisonVisRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonRad,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonVisRad,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonVisRad,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%MorisonRad,1), UBOUND(InData%MorisonRad,1) - ReKiBuf(Re_Xferred) = InData%MorisonRad(i1) + DO i1 = LBOUND(InData%MorisonVisRad,1), UBOUND(InData%MorisonVisRad,1) + ReKiBuf(Re_Xferred) = InData%MorisonVisRad(i1) Re_Xferred = Re_Xferred + 1 END DO END IF @@ -1550,21 +1550,21 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonRad not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonVisRad not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MorisonRad)) DEALLOCATE(OutData%MorisonRad) - ALLOCATE(OutData%MorisonRad(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%MorisonVisRad)) DEALLOCATE(OutData%MorisonVisRad) + ALLOCATE(OutData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%MorisonRad,1), UBOUND(OutData%MorisonRad,1) - OutData%MorisonRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + DO i1 = LBOUND(OutData%MorisonVisRad,1), UBOUND(OutData%MorisonVisRad,1) + OutData%MorisonVisRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 END DO END IF