From c26f800c35425d7bacc17bd3e56956dfe8e076a0 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Tue, 2 Apr 2024 17:02:14 -0600 Subject: [PATCH 1/8] Adding bodies and rods to FF --- modules/moordyn/src/MoorDyn.f90 | 47 +++++++++++++++++++++++++++-- modules/moordyn/src/MoorDyn_Rod.f90 | 2 +- 2 files changed, 46 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index e3304fdd48..097581e7db 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -877,7 +877,29 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%FreeBodyIs(p%nFreeBodies) = l - ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + else if ((let1 == "TURBINE") .or. (let1 == "T")) then ! turbine-coupled in FAST.Farm case + + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing turbine index + + if ((J <= p%nTurbines) .and. (J > 0)) then + + m%BodyList(l)%typeNum = -1 ! set as coupled type + p%nCpldBodies(J)=p%nCpldBodies(J)+1 ! increment counter for the appropriate turbine + m%CpldBodyIs(p%nCpldBodies(J),J) = l + CALL WrScr(' added Body '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Added Body '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J)) + end if + + else + CALL SetErrStat( ErrID_Fatal, "Turbine ID out of bounds for Body "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Body "//trim(Num2LStr(l))//" Turbine attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if else if (let1 == "FREE") then ! if a free body m%BodyList(l)%typeNum = 0 @@ -1058,7 +1080,28 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%CpldRodIs(p%nCpldRods(1),1) = l m%FreeRodIs(p%nFreeRods) = l - ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + else if ((let1 == "TURBINE") .or. (let1 == "T")) then ! turbine-coupled in FAST.Farm case + + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing turbine index + + if ((J <= p%nTurbines) .and. (J > 0)) then + m%RodList(l)%typeNum = -2 ! set as coupled type + p%nCpldRods(J)=p%nCpldRods(J)+1 ! increment counter for the appropriate turbine + m%CpldRodIs(p%nCpldRods(J),J) = l + CALL WrScr(' added Rod '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Added Rod '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J)) + end if + + else + CALL SetErrStat( ErrID_Fatal, "Turbine ID out of bounds for Rod "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Rod "//trim(Num2LStr(l))//" Turbine attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if else if ((let1 == "ROD") .or. (let1 == "R") .or. (let1 == "FREE")) then m%RodList(l)%typeNum = 0 diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index f5f718198a..9c7c7aed9e 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -259,7 +259,7 @@ SUBROUTINE Rod_SetKinematics(Rod, r6_in, v6_in, a6_in, t, m) ! handled, along with passing kinematics to dependent lines, by separate call to setState else - print *, "Error: Rod_SetKinematics called for a free Rod in MoorDyn." ! <<< + print *, "Error: Rod_SetKinematics called for a free Rod in MoorDyn. Rod number", Rod%IdNum ! <<< end if From 462d6d5bfa6f0d97cd3356d95f964e03643de9d5 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 22 Apr 2024 14:07:05 -0600 Subject: [PATCH 2/8] Added rotational drag and fixed orientation for drag coefficients --- modules/moordyn/src/MoorDyn.f90 | 20 ++++++++++++++++++++ modules/moordyn/src/MoorDyn_Body.f90 | 19 ++++++++++++++++--- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 097581e7db..9466358cb1 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -811,10 +811,30 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er READ(tempString4, *) m%BodyList(l)%BodyCdA(1) m%BodyList(l)%BodyCdA(2) = m%BodyList(l)%BodyCdA(1) m%BodyList(l)%BodyCdA(3) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(4) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(5) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(6) = m%BodyList(l)%BodyCdA(1) + else if (N ==2) then + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) + READ(tempStrings(4), *) m%BodyList(l)%BodyCdA(4) + m%BodyList(l)%BodyCdA(2) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(3) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(5) = m%BodyList(l)%BodyCdA(4) + m%BodyList(l)%BodyCdA(6) = m%BodyList(l)%BodyCdA(4) else if (N==3) then ! all three coordinates provided READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(2) READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(3) + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(4) + READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(5) + READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(6) + else if (N==6) then + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(3) + READ(tempStrings(4), *) m%BodyList(l)%BodyCdA(4) + READ(tempStrings(5), *) m%BodyList(l)%BodyCdA(5) + READ(tempStrings(6), *) m%BodyList(l)%BodyCdA(6) else CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CdA entry (col 13) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) end if diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index acf6f92098..9415030ed9 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -407,7 +407,7 @@ SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) ! check for NaNs (should check all state derivatives, not just first 6) DO J = 1, 6 IF (Is_NaN(Xd(J))) THEN - CALL WrScr("NaN detected at time "//trim(Num2LStr(Body%time))//" in Body "//trim(Int2LStr(Body%IdNum))//"in MoorDyn,") + CALL WrScr("NaN detected at time "//trim(Num2LStr(Body%time))//" in Body "//trim(Int2LStr(Body%IdNum))//" in MoorDyn,") IF (wordy > 0) print *, "state derivatives:" IF (wordy > 0) print *, Xd EXIT @@ -436,6 +436,9 @@ SUBROUTINE Body_DoRHS(Body, m, p) Real(DbKi) :: vi(6) ! relative water velocity (last 3 terms are rotatonal and will be set to zero Real(DbKi) :: F6_i(6) ! net force and moments from an attached object Real(DbKi) :: M6_i(6,6) ! mass and inertia from an attached object + Real(DbKi) :: cda(6) ! body drag coefficients + Real(DbKi) :: cda_t(3,3) = 0.0 ! matrix with translational drag coefficients as diagonals + Real(DbKi) :: cda_r(3,3) = 0.0 ! matrix with rotational drag coefficients as diagonals ! Initialize variables U = 0.0_DbKi ! Set to zero for now @@ -465,8 +468,18 @@ SUBROUTINE Body_DoRHS(Body, m, p) vi(1:3) = U - Body%v6(1:3) ! relative flow velocity over body ref point vi(4:6) = - Body%v6(4:6) ! for rotation, this is just the negative of the body's rotation for now (not allowing flow rotation) - Body%F6net = Body%F6net + 0.5*p%rhoW * vi * abs(vi) * Body%bodyCdA - ! <<< NOTE, for body this should be fixed to account for orientation!! <<< what about drag in rotational DOFs??? <<<<<<<<<<<<<< + cda_t(1,1) = Body%bodyCdA(1) + cda_t(2,2) = Body%bodyCdA(2) + cda_t(3,3) = Body%bodyCdA(3) + cda_r(1,1) = Body%bodyCdA(4) + cda_r(2,2) = Body%bodyCdA(5) + cda_r(3,3) = Body%bodyCdA(6) + + cda(1:3) = MATMUL( MATMUL( MATMUL(Body%OrMat,cda_t) , transpose(Body%OrMat) ) , vi(1:3) * norm2(vi(1:3)) ); + cda(4:6) = MATMUL( MATMUL( MATMUL(Body%OrMat,cda_r) , transpose(Body%OrMat) ) , vi(4:6) * norm2(vi(4:6)) ); + Body%F6net = Body%F6net + 0.5*p%rhoW*cda + + From 41ecd9f939278300db0b0afbe92aba31124b72a9 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Fri, 10 May 2024 09:58:30 -0600 Subject: [PATCH 3/8] Line loss/failures added to MoorDyn --- modules/moordyn/src/MoorDyn.f90 | 441 ++++++++++++++++++++++---- modules/moordyn/src/MoorDyn_IO.f90 | 10 +- modules/moordyn/src/MoorDyn_Point.f90 | 11 +- modules/moordyn/src/MoorDyn_Rod.f90 | 32 +- modules/moordyn/src/MoorDyn_Types.f90 | 36 ++- 5 files changed, 438 insertions(+), 92 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 9466358cb1..35cd383e08 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -76,6 +76,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! CHARACTER(1024) :: priPath ! The path to the primary MoorDyn input file REAL(DbKi) :: t ! instantaneous time, to be used during IC generation INTEGER(IntKi) :: l ! index + INTEGER(IntKi) :: il ! index + INTEGER(IntKi) :: iil ! index + INTEGER(IntKi) :: Success ! flag for checking whether line is attached to failure point INTEGER(IntKi) :: I ! Current line number of input file INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index @@ -556,7 +559,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ALLOCATE(m%BodyList( p%nBodies ), STAT = ErrStat2 ); if(AllocateFailed("BodyList" )) return ALLOCATE(m%RodList( p%nRods ), STAT = ErrStat2 ); if(AllocateFailed("RodList" )) return - ALLOCATE(m%PointList( p%nPoints ), STAT = ErrStat2 ); if(AllocateFailed("PointList" )) return + ALLOCATE(m%PointList( p%nPointsExtra), STAT = ErrStat2 ); if(AllocateFailed("PointList" )) return ALLOCATE(m%LineList( p%nLines ), STAT = ErrStat2 ); if(AllocateFailed("LineList" )) return ALLOCATE(m%FailList( p%nFails ), STAT = ErrStat2 ); if(AllocateFailed("FailList" )) return @@ -565,16 +568,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! Allocate associated index arrays (note: some are allocated larger than will be used, for simplicity) ALLOCATE(m%BodyStateIs1(p%nBodies ), m%BodyStateIsN(p%nBodies ), STAT=ErrStat2); if(AllocateFailed("BodyStateIs1/N")) return ALLOCATE(m%RodStateIs1(p%nRods ), m%RodStateIsN(p%nRods ), STAT=ErrStat2); if(AllocateFailed("RodStateIs1/N" )) return - ALLOCATE(m%PointStateIs1(p%nPoints), m%PointStateIsN(p%nPoints), STAT=ErrStat2); if(AllocateFailed("PointStateIs1/N" )) return + ALLOCATE(m%PointStateIs1(p%nPointsExtra), m%PointStateIsN(p%nPointsExtra), STAT=ErrStat2); if(AllocateFailed("PointStateIs1/N" )) return ALLOCATE(m%LineStateIs1(p%nLines) , m%LineStateIsN(p%nLines) , STAT=ErrStat2); if(AllocateFailed("LineStateIs1/N")) return ALLOCATE(m%FreeBodyIs( p%nBodies ), STAT=ErrStat2); if(AllocateFailed("FreeBodyIs")) return ALLOCATE(m%FreeRodIs( p%nRods ), STAT=ErrStat2); if(AllocateFailed("FreeRodIs")) return - ALLOCATE(m%FreePointIs( p%nPoints), STAT=ErrStat2); if(AllocateFailed("FreePointIs")) return + ALLOCATE(m%FreePointIs(p%nPointsExtra), STAT=ErrStat2); if(AllocateFailed("FreePointIs")) return ALLOCATE(m%CpldBodyIs(p%nBodies , p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldBodyIs")) return ALLOCATE(m%CpldRodIs( p%nRods , p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldRodIs")) return - ALLOCATE(m%CpldPointIs(p%nPoints, p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldPointIs")) return + ALLOCATE(m%CpldPointIs(p%nPointsExtra, p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldPointIs")) return ! ---------------------- now go through again and process file contents -------------------- @@ -1453,7 +1456,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er return end if else - CALL SetErrStat( ErrID_Fatal, "Error: rod point ID out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, " Rod ID out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) return end if @@ -1494,7 +1497,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er return end if else - CALL SetErrStat( ErrID_Fatal, "Error: rod connection ID out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, " Rod ID out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) return end if @@ -1589,6 +1592,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! count commas to determine how many line IDs specified for this channel N = count(transfer(Line, 'a', len(Line)) == ",") + 1 ! number of line IDs given + + ! check for correct number of columns in current line (CountWords splits by comma and space, so 2 columns means number of line ID's plus one more for the control channel) + IF ( CountWords( Line ) /= N+1 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse controls '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 2 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF ! parse out entries: CtrlChan, LineIdNums read(Line, *) Itemp, TempIDnums(1:N) ! parse out each line ID @@ -1602,16 +1612,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er write(p%UnLog,'(A)') 'Assigned Line '//TRIM(Int2LStr(TempIDnums(J)))//' to control channel '//TRIM(Int2LStr(Itemp)) end if else - CALL WrScr('Error: Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp))) - if (p%writeLog > 0) then - write(p%UnLog,'(A)') 'Error: Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp)) - end if + CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return end if else - CALL WrScr('Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range') - if (p%writeLog > 0) then - write(p%UnLog,'(A)') 'Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range' - end if + CALL SetErrStat( ErrID_Fatal, ' Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return end if END DO @@ -1621,12 +1629,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !------------------------------------------------------------------------------------------- else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header - - CALL WrScr(" Warning: Failure capabilities are not yet implemented in MoorDyn.") - if (p%writeLog > 0) then - write(p%UnLog,'(A)') " Warning: Failure capabilities are not yet implemented in MoorDyn." - end if + IF (wordy > 0) then + CALL WrScr(" Reading failure inputs") + endif + + ! TODO: allocate fail list size (we need to do this before though right?) + + ! skip following two lines (label line and unit line) Line = NextLine(i) Line = NextLine(i) @@ -1636,13 +1646,169 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !read into a line Line = NextLine(i) + + ! count commas to determine how many line IDs specified for this channel + N = count(transfer(Line, 'a', len(Line)) == ",") + 1 ! number of line IDs given + ! check for correct number of columns in current line (CountWords splits by comma and space, so 2 columns means number of line ID's plus 4 more for the other 4 channels) - ! TODO: Failure capabilities still need to be completed - READ(Line,*,IOSTAT=ErrStat2) m%LineList(l)%IdNum, tempString1, m%LineList(l)%UnstrLen, & - m%LineList(l)%N, tempString2, tempString3, LineOutString - - END DO - + IF ( CountWords( Line ) /= N+4 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 5 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: FailID Point Lines FailTime FailTen + IF (ErrStat2 == 0) THEN + + READ(Line,*,IOSTAT=ErrStat2) m%FailList(l)%IdNum, TempString1, TempIDnums(1:N), m%FailList(l)%failTime, m%FailList(l)%failTen + + ! check for duplicate failure ID's + ! check for sequential IdNums + IF ( m%FailList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failure ID numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + CALL Conv2UC(TempString1) ! convert to uppercase so that matching is not case-sensitive + + call DecomposeString(TempString1, let1, num1, let2, num2, let3) ! divided failPoint into letters and numbers + + if (len_trim(num1)<1) then + CALL SetErrStat( ErrID_Fatal, "Error: no point number provided for line failure "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + end if + + READ(num1, *) m%FailList(l)%attachID ! convert to int + + ! if id starts with an "R" or "Rod" + if ((let1 == "R") .OR. (let1 == "ROD")) then + if ((m%FailList(l)%attachID <= p%nRods) .AND. (m%FailList(l)%attachID > 0)) then + if (let2 == "A") then + m%FailList(l)%isRod = 1 + else if (let2 == "B") then + m%FailList(l)%isRod = 2 + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Rod end must be A or B.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Rod number out of bounds.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + endif + + if ((len_trim(let1)<1) .OR. (let1 == "P") .OR. (let1 == "POINT")) then + if ((m%FailList(l)%attachID <= p%nPoints) .AND. (m%FailList(l)%attachID > 0)) then + m%FailList(l)%isRod = 0 + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Point number out of bounds.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + endif + + ! get lines + m%FailList(l)%nLinesToDetach = N + + DO il = 1, m%FailList(l)%nLinesToDetach + if (TempIDnums(il) <= p%nLines) then ! ensure line ID is in range + m%FailList(l)%lineIDs(il) = TempIDnums(il) + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Line number '//TRIM(Int2LStr(TempIDnums(il)))//' out of bounds.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + ! check whether line is attached to fail point at fairlead or anchor and assing line tops + if (m%FailList(l)%isRod == 0) then ! point + + Success = 0 + DO iil = 1, m%PointList(m%FailList(l)%attachID)%nAttached ! find index of line + if (m%PointList(m%FailList(l)%attachID)%Attached(iil) == m%FailList(l)%lineIDs(il)) then + m%FailList(l)%lineTops(il) = m%PointList(m%FailList(l)%attachID)%Top(iil) + Success = 1 + exit + endif + ENDDO + + if (Success == 0) then + CALL SetErrStat( ErrID_Fatal, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" not attached to point "//trim(num2lstr(m%FailList(l)%attachID))//" for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + elseif (m%FailList(l)%isRod == 1) then ! Rod end A + + Success = 0 + DO iil = 1, m%RodList(m%FailList(l)%attachID)%nAttachedA ! find index of line + if (m%RodList(m%FailList(l)%attachID)%AttachedA(iil) == m%FailList(l)%lineIDs(il)) then + m%FailList(l)%lineTops(il) = m%RodList(m%FailList(l)%attachID)%TopA(iil) + Success = 1 + exit + endif + ENDDO + + if (Success == 0) then + CALL SetErrStat( ErrID_Fatal, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" not attached to R"//trim(num2lstr(m%FailList(l)%attachID))//"A for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + elseif (m%FailList(l)%isRod == 2) then ! Rod end B + + Success = 0 + DO iil = 1, m%RodList(m%FailList(l)%attachID)%nAttachedB ! find index of line + if (m%RodList(m%FailList(l)%attachID)%AttachedB(iil) == m%FailList(l)%lineIDs(il)) then + m%FailList(l)%lineTops(il) = m%RodList(m%FailList(l)%attachID)%TopB(iil) + Success = 1 + exit + endif + ENDDO + + if (Success == 0) then + CALL SetErrStat( ErrID_Fatal, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" not attached to R"//trim(num2lstr(m%FailList(l)%attachID))//"B for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + else + CALL SetErrStat( ErrID_Fatal, " isRod out of range for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + ENDDO + + ! cant have both time and tension conditions, time is prioritized + if ((m%FailList(l)%failTime > 0) .AND. (m%FailList(l)%failTen > 0)) then + CALL SetErrStat( ErrID_Info, ' MoorDyn failure condition checks time before tension. If time reached before tension, failure '//trim(Num2LStr(m%FailList(l)%IdNum))//' will trigger.', ErrStat, ErrMsg, RoutineName ) + endif + + if ((m%PointList(m%FailList(l)%attachID)%typeNum == 0) .AND. (m%PointList(m%FailList(l)%attachID)%nAttached == m%FailList(l)%nLinesToDetach)) then + + ! if X lines called to fail from a free point with only X lines attached + Call SetErrStat(ErrID_Warn, trim(num2lstr(m%FailList(l)%nLinesToDetach))//" lines called to fail from a free point with only "//trim(num2lstr(m%FailList(l)%nLinesToDetach))//" lines attached. Failure "//trim(num2lstr(l))//" ignored.", ErrStat, ErrMsg, RoutineName ) + m%FailList(l)%failStatus = 2 + + elseif ((m%FailList(l)%failTime == 0) .AND. (m%FailList(l)%failTen == 0)) then + + CALL SetErrStat( ErrID_Warn, ' MoorDyn failure condition must have non-zero time or tension. Failure condition '//trim(Num2LStr(m%FailList(l)%IdNum))//' ignored.', ErrStat, ErrMsg, RoutineName ) + m%FailList(l)%failStatus = 2 + + else + + m%FailList(l)%failStatus = 0; ! initialize as unfailed + + endif + + endif + enddo + !------------------------------------------------------------------------------------------- else if (INDEX(Line, "OUTPUT") > 0) then ! if output header @@ -1851,13 +2017,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! prepare state vector etc. !------------------------------------------------------------------------------------ - ! the number of states is Nx + ! the number of states is Nx and Nxtra includes additional states for potential line failures m%Nx = Nx + m%Nxtra = m%Nx + 6*2*p%nLines - IF (wordy > 0) print *, "allocating state vectors to size ", Nx + IF (wordy > 0) print *, "allocating state vectors to size ", m%Nxtra ! allocate state vector and temporary state vectors based on size just calculated - ALLOCATE ( x%states(m%Nx), m%xTemp%states(m%Nx), m%xdTemp%states(m%Nx), STAT = ErrStat2 ) + ALLOCATE ( x%states(m%Nxtra), m%xTemp%states(m%Nxtra), m%xdTemp%states(m%Nxtra), STAT = ErrStat2 ) IF ( ErrStat2 /= ErrID_None ) THEN ErrMsg = ' Error allocating state vectors.' !CALL CleanUp() @@ -2561,7 +2728,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er INTEGER(IntKi) , INTENT(IN ) :: n TYPE(MD_InputType) , INTENT(INOUT) :: u(:) ! INTENT(INOUT) ! had to change this to INOUT REAL(DbKi) , INTENT(IN ) :: t_array(:) - TYPE(MD_ParameterType) , INTENT(IN ) :: p ! INTENT(IN ) + TYPE(MD_ParameterType) , INTENT(INOUT) :: p ! INTENT(IN ) TYPE(MD_ContinuousStateType) , INTENT(INOUT) :: x ! INTENT(INOUT) TYPE(MD_DiscreteStateType) , INTENT(INOUT) :: xd ! INTENT(INOUT) TYPE(MD_ConstraintStateType) , INTENT(INOUT) :: z ! INTENT(INOUT) @@ -2583,6 +2750,8 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er INTEGER(IntKi) :: NdtM ! number of time steps to integrate through with RK2 INTEGER(IntKi) :: I INTEGER(IntKi) :: J + INTEGER(IntKi) :: l, li, lii, il ! index + INTEGER(IntKi) :: tension ! tension at line attachment to failure point nTime = size(u) ! the number of times of input data provided? <<<<<<< not used @@ -2637,22 +2806,15 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er IF (Is_NaN(x%states(J))) THEN ErrStat = ErrID_Fatal ErrMsg = ' NaN state detected.' + IF (wordy > 1) THEN + print *, ". Here is the state vector: " + print *, x%states + END IF + CALL CheckError(ErrStat, ErrMsg) EXIT END IF END DO - IF (ErrStat == ErrID_Fatal) THEN - CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") - if (p%writeLog > 0) then - write(p%UnLog,'(A)') "NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn." - end if - IF (wordy > 1) THEN - print *, ". Here is the state vector: " - print *, x%states - END IF - EXIT - END IF - END DO ! I time steps @@ -2662,6 +2824,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er CALL MD_DestroyInput(u_interp, ErrStat, ErrMsg) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error destroying dxdt or x2.' + CALL CheckError(ErrStat, ErrMsg) END IF ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_UpdateStates') @@ -2671,23 +2834,181 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er IF (Is_NaN(x%states(J))) THEN ErrStat = ErrID_Fatal ErrMsg = ' NaN state detected.' + IF (wordy > 1) THEN + print *, ". Here is the state vector: " + print *, x%states + END IF + CALL CheckError(ErrStat, ErrMsg) EXIT END IF END DO - - IF (ErrStat == ErrID_Fatal) THEN - CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") - if (p%writeLog > 0) then - write(p%UnLog,'(A)') "NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn." - end if - IF (wordy > 1) THEN - print *, ". Here is the state vector: " - print *, x%states - END IF - END IF + + ! do we want to check failures here (at the coupling step level? Or at the dtM level?) + ! --------------- check for line failures (detachments!) ---------------- + DO l= 1,p%nFails + + if (m%FailList(l)%failStatus == 0) then + + if ((t >= m%FailList(l)%failTime) .AND. (m%FailList(l)%failTime .NE. 0.0)) then + + ! step 1: check for time-triggered failures + + CALL WrScr("Failure number "//trim(Num2LStr(l))//" triggered by t = "//trim(Num2LStr(t))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Failure number "//trim(Num2LStr(l))//" triggered by t = "//trim(Num2LStr(t)) + end if + + m%FailList(l)%failStatus = 1; ! set status to failed so it's not checked again + CALL DetachLines(m%FailList(l)%attachID, m%FailList(l)%isRod, m%FailList(l)%lineIDs, m%FailList(l)%lineTops, m%FailList(l)%nLinesToDetach, t) + + elseif (m%FailList(l)%failTen .NE. 0.0) then + + ! step 2: check for tension-triggered failures (this will require specifying max tension things) + + DO il = 1,m%FailList(l)%nLinesToDetach ! for each line in the failure, check the tension at the attachment + + ! check line ID is right + if (m%FailList(l)%lineIDs(il) .NE. m%LineList(m%FailList(l)%lineIDs(il))%IdNum) then + CALL CheckError(ErrID_Fatal, " Line ID's dont match for failure "//trim(num2lstr(m%FailList(l)%IdNum))) + endif + + ! if fairlead else anchor + if (m%FailList(l)%lineTops(il) == 1) then + tension = Line_GetNodeTen(m%LineList(m%FailList(l)%lineIDs(il)), m%LineList(m%FailList(l)%lineIDs(il))%N) + else + tension = Line_GetNodeTen(m%LineList(m%FailList(l)%lineIDs(il)), 0) + endif + + if (tension >= m%FailList(l)%failTen) then + CALL WrScr("Failure number "//trim(Num2LStr(l))//" triggered by line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" tension = "//trim(Num2LStr(tension))//" at time = "//trim(Num2LStr(t))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Failure number "//trim(Num2LStr(l))//" triggered by line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" tension = "//trim(Num2LStr(tension))//" at time = "//trim(Num2LStr(t)) + end if + + m%FailList(l)%failStatus = 1; ! set status to failed so it's not checked again + CALL DetachLines(m%FailList(l)%attachID, m%FailList(l)%isRod, m%FailList(l)%lineIDs, m%FailList(l)%lineTops, m%FailList(l)%nLinesToDetach, t) + exit ! dont need to check the other lines becasue failure already detected + + endif + + ENDDO ! il = 1,m%FailList(l)%nLinesToDetach + + endif ! end checking time and tension thresholds non-zero + + if (m%FailList(l)%failStatus == 1) then + + ! if a failure is triggered, remove all lines from that failure from all other failures + DO li = 1, p%nFails + if (m%FailList(li)%IdNum .NE. m%FailList(l)%IdNum) then ! if not this failure + if ((m%FailList(l)%attachID == m%FailList(li)%attachID) .AND. (m%FailList(l)%isRod == m%FailList(li)%isRod)) then ! if failures are for the same point + + DO il = 1, m%FailList(l)%nLinesToDetach ! loop through lines of this failure + DO lii = 1, m%FailList(li)%nLinesToDetach ! loop through lines of the other failure + + if (m%FailList(l)%lineIDs(il) == m%FailList(li)%lineIDs(lii)) then ! if this failure's line IDs are found in any of the other failure's line IDs + + m%FailList(li)%nLinesToDetach = m%FailList(li)%nLinesToDetach - 1 ! reduce the size of nLinesToDetach of the other failure + m%FailList(li)%lineIDs(lii) = m%FailList(li)%lineIDs(lii+1) ! move subsequent line ID's forward one spot in the list to eliminate this line ID + CALL CheckError(ErrID_Warn, "Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" removed from Failure "//trim(num2lstr(li))//" becasue it already failed by Failure "//trim(num2lstr(l))) + + endif + + ENDDO + ENDDO + + if (m%FailList(li)%nLinesToDetach == 0) then + ! invalid failure + m%FailList(li)%failStatus = 2 + CALL CheckError (ErrID_Warn, "Failure "//trim(num2lstr(li))//" is a duplicate of failure "//trim(num2lstr(l))//" and will be ignored.") + endif + + endif + endif + ENDDO !li = 1, p%nFails + endif ! m%FailList(l)%failStatus == 1 + + endif ! m%FailList(l)%failStatus == 0 + + ENDDO ! l= 0,nFails CONTAINS + SUBROUTINE DetachLines (attachID, isRod, lineIDs, lineTops, nLinesToDetach, time) + INTEGER(IntKi), INTENT(IN) :: attachID + INTEGER(IntKi), INTENT(IN) :: isRod + INTEGER(IntKi), INTENT(IN ) :: lineIDs(:) + INTEGER(IntKi), INTENT( OUT) :: lineTops(:) + INTEGER(IntKi), INTENT(IN) :: nLinesToDetach + REAL(DbKi), INTENT(IN ) :: time + INTEGER(IntKi) :: k ! index + REAL(DbKi) :: dummyPointState(6) = 0.0_DbKi ! dummy state array to hold kinematics of old attachment point (format in terms of part of point state vector: r[J] = X[3 + J]; rd[J] = X[J]; ) + + ! add point to list of free ones and add states for it + p%nPoints = p%nPoints + 1 ! add 1 to the number of points (this is now the number of the new point) + p%nFreePoints=p%nFreePoints+1 + m%FreePointIs(p%nFreePoints) = p%nPoints + m%PointStateIs1(p%nFreePoints) = m%Nx+1 ! assign start index of this point's states + m%PointStateIsN(p%nFreePoints) = m%Nx+6 + m%Nx = m%Nx + 6 ! add 6 state variables for each point + + ! note: for the DetachLines subroutine, p%nPoints == m%FreePointIs(p%nFreePoints) and can be used interchangeably for indexing. p%nPoints is used to make things easier to read + + ! check to make sure we haven't gone beyond the extra size allotted to the state arrays or the points list <<<< really should throw an error here + if (p%nPoints > p%nPointsExtra) then + CALL CheckError(ErrID_Fatal, " DetachLines: p%nPoints > p%nPointsExtra") + endif + if (m%Nx > m%Nxtra) then + CALL CheckError(ErrID_Fatal, " DetachLines: nX > m%Nx") + endif + + ! create new massless point for detached end(s) of line(s) + m%PointList(p%nPoints)%IdNum = p%nPoints + m%PointList(p%nPoints)%r = 0.0_DbKi ! will be set by Point_SetState + m%PointList(p%nPoints)%rd = 0.0_DbKi ! will be set by Point_SetState + m%PointList(p%nPoints)%pointM = 0.0_DbKi + m%PointList(p%nPoints)%pointV = 0.0_DbKi + m%PointList(p%nPoints)%pointCa = 0.0_DbKi + m%PointList(p%nPoints)%pointCda = 0.0_DbKi + m%PointList(p%nPoints)%typeNum = 0_IntKi ! free point + ! not used + m%PointList(p%nPoints)%pointFX = 0.0_DbKi + m%PointList(p%nPoints)%pointFY = 0.0_DbKi + m%PointList(p%nPoints)%pointFZ = 0.0_DbKi + CALL Point_Initialize(m%PointList(p%nPoints), x%states(m%PointStateIs1(p%nFreePoints) : m%pointStateIsN(p%nFreePoints)), m) + + ! detach lines from old Rod or Point, and get kinematics of the old attachment point + + DO k=1,nLinesToDetach + + if (isRod==1) then ! end A + CALL Rod_RemoveLine(m%RodList(attachID), lineIDs(k), lineTops(k), 0, dummyPointState(4:6), dummyPointState(1:3)) + elseif (isRod==2) then ! end B + CALL Rod_RemoveLine(m%RodList(attachID), lineIDs(k), lineTops(k), 1, dummyPointState(4:6), dummyPointState(1:3)) + elseif (isRod==0) then + CALL Point_RemoveLine(m%PointList(attachID), lineIDs(k), lineTops(k), dummyPointState(4:6), dummyPointState(1:3)) + else + CALL CheckError(ErrID_Fatal, " DetachLines: Failure doesn't have a valid isRod value of 0, 1, or 2.") + endif + + ENDDO + + ! attach lines to new point + DO k=1,nLinesToDetach ! for each relevant line + CALL Point_AddLine(m%PointList(p%nPoints), lineIDs(k), lineTops(k)) + ENDDO + + ! update point kinematics to match old line attachment point kinematics and set positions of attached line ends + CALL Point_SetState(m%PointList(p%nPoints),dummyPointState, time, m) + + ! now make the state vector up to date! + DO k=1,6 + x%states(m%PointStateIs1(p%nFreePoints)+(k-1)) = dummyPointState(k) + ENDDO + + IF (wordy > 0) print *, "Set up new Point ", p%nPoints, " of type ", m%PointList(p%nPoints)%typeNum + + END SUBROUTINE DetachLines + SUBROUTINE CheckError(ErrId, Msg) ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev @@ -2701,14 +3022,16 @@ SUBROUTINE CheckError(ErrId, Msg) ErrMsg = TRIM(ErrMsg)//' MD_UpdateStates:'//TRIM(Msg) ! add current error message ErrStat = MAX(ErrStat, ErrID) - CALL WrScr( ErrMsg ) ! do this always or only if warning level? - if (p%writeLog > 0) then - write(p%UnLog,'(A)') ErrMsg - end if + ! if (ErrStat <= ErrID_Warn) then + ! CALL WrScr( ErrMsg ) ! do this always or only if warning level? + ! endif IF( ErrStat > ErrID_Warn ) THEN + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ErrMsg + end if ! CALL MD_DestroyInput( u_interp, ErrStat, ErrMsg ) - RETURN + RETURN END IF END IF @@ -2947,8 +3270,8 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index INTEGER(IntKi) :: iTurb ! index -! INTEGER(IntKi) :: Istart ! start index of line/connect in state vector -! INTEGER(IntKi) :: Iend ! end index of line/connect in state vector +! INTEGER(IntKi) :: Istart ! start index of line/point in state vector +! INTEGER(IntKi) :: Iend ! end index of line/point in state vector ! REAL(DbKi) :: temp(3) ! temporary for passing kinematics diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 5a5f319a09..82ec10f977 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -118,6 +118,7 @@ MODULE MoorDyn_IO PUBLIC :: MDIO_CloseOutput PUBLIC :: MDIO_ProcessOutList PUBLIC :: MDIO_WriteOutputs + PUBLIC :: Line_GetNodeTen CONTAINS @@ -1365,11 +1366,11 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) CASE (FZ) y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%Fnet(3,p%OutParam(I)%NodeID) ! node force in z CASE (Ten) - y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), p%OutParam(I)%NodeID, p) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), p%OutParam(I)%NodeID) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! CASE (TenA) - y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), 0, p) + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), 0) CASE (TenB) - y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), m%LineList(p%OutParam(I)%ObjID)%N, p) + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), m%LineList(p%OutParam(I)%ObjID)%N) CASE DEFAULT y%WriteOutput(I) = 0.0_ReKi ErrStat = ErrID_Warn @@ -1886,11 +1887,10 @@ END SUBROUTINE MDIO_WriteOutputs ! get tension at any node including fairlead or anchor (accounting for weight in these latter cases) !-------------------------------------------------------------- - FUNCTION Line_GetNodeTen(Line, i, p) result(NodeTen) + FUNCTION Line_GetNodeTen(Line, i) result(NodeTen) TYPE(MD_Line), INTENT(IN ) :: Line ! label for the current line, for convenience INTEGER(IntKi), INTENT(IN ) :: i ! node index to get tension at - TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters REAL(DbKi) :: NodeTen ! returned calculation of tension at node INTEGER(IntKi) :: J diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 index 9328f4805d..dc0f233284 100644 --- a/modules/moordyn/src/MoorDyn_Point.f90 +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -379,6 +379,7 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) REAL(DbKi), INTENT(INOUT) :: rdEnd(3) Integer(IntKi) :: l,m,J + Integer(IntKi) :: found = 0 DO l = 1,Point%nAttached ! look through attached lines @@ -386,7 +387,7 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) TopOfLine = Point%Top(l); ! record which end of the line was attached - DO m = l,Point%nAttached-1 + DO m = l,Point%nAttached Point%Attached(m) = Point%Attached(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link Point%Top( m) = Point%Top(m+1) @@ -404,13 +405,15 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) EXIT END DO - IF (l == Point%nAttached) THEN ! detect if line not found - print *, "Error: failed to find line to remove during removeLineFromPoint call to point ", Point%IdNum, ". Line ", lineID - END IF + found = 1 END IF END DO + + IF (found == 0) THEN ! detect if line not found TODO: fix this, its wrong. If pointNnattached is oprginally 2, then it will be 1 after one run of the loop and l will also be 1 + CALL WrScr("Error: failed to find line to remove during RemoveLine call to Point "//trim(num2lstr(Point%IdNum))//". Line "//trim(num2lstr(lineID))) + END IF END SUBROUTINE Point_RemoveLine diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index 9c7c7aed9e..b5d51bc2d0 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -1113,6 +1113,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) REAL(DbKi), INTENT(INOUT) :: rdEnd(3) Integer(IntKi) :: l,m,J + Integer(IntKi) :: foundA, foundB = 0 if (endB==1) then ! attaching to end B @@ -1122,7 +1123,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) TopOfLine = Rod%TopB(l); ! record which end of the line was attached - DO m = l,Rod%nAttachedB-1 + DO m = l,Rod%nAttachedB Rod%AttachedB(m) = Rod%AttachedB(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link Rod%TopB( m) = Rod%TopB(m+1) @@ -1135,17 +1136,19 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) rdEnd(J) = Rod%rd(J,Rod%N) END DO - call WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end B") + CALL WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end B") EXIT END DO - - IF (l == Rod%nAttachedB) THEN ! detect if line not found - print *, "Error: failed to find line to remove during RemoveLine call to Rod ", Rod%IdNum, ". Line ", lineID - END IF + + foundB = 1 + END IF END DO - + IF (foundB == 0) THEN ! detect if line not found + CALL WrScr("Error: failed to find line to remove during RemoveLine call to Rod "//trim(num2lstr(Rod%IdNum))//" end B. Line "//trim(num2lstr(lineID))) + END IF + else ! attaching to end A DO l = 1,Rod%nAttachedA ! look through attached lines @@ -1154,7 +1157,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) TopOfLine = Rod%TopA(l); ! record which end of the line was attached - DO m = l,Rod%nAttachedA-1 + DO m = l,Rod%nAttachedA Rod%AttachedA(m) = Rod%AttachedA(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link Rod%TopA( m) = Rod%TopA(m+1) @@ -1167,16 +1170,19 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) rdEnd(J) = Rod%rd(J,0) END DO - call WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end A") + CALL WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end A") EXIT END DO - - IF (l == Rod%nAttachedA) THEN ! detect if line not found - print *, "Error: failed to find line to remove during RemoveLine call to Rod ", Rod%IdNum, ". Line ", lineID - END IF + + foundA = 1 + END IF END DO + + IF (foundA == 0) THEN ! detect if line not found + CALL WrScr("Error: failed to find line to remove during RemoveLine call to Rod "//trim(num2lstr(Rod%IdNum))//" end A. Line "//trim(num2lstr(lineID))) + END IF end if diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 6f94451de3..69a4418bf5 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -105,8 +105,8 @@ MODULE MoorDyn_Types TYPE, PUBLIC :: MD_Body INTEGER(IntKi) :: IdNum !< integer identifier of this Point [-] INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of points attached to this body [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0 !< list of IdNums of points attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0 !< list of IdNums of rods attached to this body [-] INTEGER(IntKi) :: nAttachedC = 0 !< number of attached points [-] INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel !< relative position of point on body [-] @@ -136,8 +136,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: IdNum !< integer identifier of this point [-] CHARACTER(10) :: type !< type of point: fix, vessel, point [-] INTEGER(IntKi) :: typeNum !< integer identifying the type. 1=fixed, -1=coupled, 0=free [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this point node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Top !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0 !< list of IdNums of lines attached to this point node [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0 !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] REAL(DbKi) :: pointM !< point mass [[kg]] REAL(DbKi) :: pointV !< point volume [[m^3]] @@ -164,10 +164,10 @@ MODULE MoorDyn_Types CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated rod properties [-] INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA !< list of IdNums of lines attached to end A [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB !< list of IdNums of lines attached to end B [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopA !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopB !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0 !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0 !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0 !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0 !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] @@ -227,8 +227,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] - INTEGER(IntKi) :: FairPoint !< IdNum of Point at fairlead [-] - INTEGER(IntKi) :: AnchPoint !< IdNum of Point at anchor [-] + INTEGER(IntKi) :: FairPoint !< IdNum of Point at fairlead. Not initialized [-] + INTEGER(IntKi) :: AnchPoint !< IdNum of Point at anchor. Not initialized [-] INTEGER(IntKi) :: N !< The number of elements in the line [-] INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] @@ -289,7 +289,15 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_Fail ======= TYPE, PUBLIC :: MD_Fail - INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + INTEGER(IntKi) :: attachID !< ID of connection or Rod the lines are attached to [-] + INTEGER(IntKi) :: isRod !< 1 Rod end A, 2 Rod end B, 0 if point [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs !< array of one or more lines to detach (starting from 1...) [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineTops !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nLinesToDetach !< how many lines to dettach [-] + REAL(DbKi) :: failTime !< time of failure [[s]] + REAL(DbKi) :: failTen !< tension threshold of failure [[N]] + INTEGER(IntKi) :: failStatus !< 0 not failed yet, 1 failed, 2 invalid [-] END TYPE MD_Fail ! ======================= ! ========= MD_OutParmType ======= @@ -368,6 +376,7 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] INTEGER(IntKi) :: Nx !< number of states and size of state vector [] + INTEGER(IntKi) :: Nxtra !< number of states and size of state vector including points for potential line failures [] INTEGER(IntKi) :: WaveTi !< current interpolation index for wave time series data [] TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] @@ -8467,6 +8476,7 @@ SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN ENDIF DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%Nxtra = SrcMiscData%Nxtra DstMiscData%WaveTi = SrcMiscData%WaveTi CALL MD_CopyContState( SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9593,6 +9603,8 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END IF IntKiBuf(Int_Xferred) = InData%Nx Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Nxtra + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%WaveTi Int_Xferred = Int_Xferred + 1 CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, OnlySize ) ! xTemp @@ -10472,6 +10484,8 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END IF OutData%Nx = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%Nxtra = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%WaveTi = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) From b1f509a748edf6faa909830ff5d88c181f51a932 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Fri, 10 May 2024 15:09:08 -0600 Subject: [PATCH 4/8] updated registry --- modules/moordyn/src/MoorDyn_Registry.txt | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 283fca0bed..b9b26f60af 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -265,9 +265,16 @@ typedef ^ ^ DbKi EndMomentB {3} typedef ^ ^ IntKi LineUnOut - - - "unit number of line output file" typedef ^ ^ DbKi LineWrOutput {:} - - "one row of output data for this line" -# this is the Fail type, which holds data for possible line failure descriptors TO BE FILLED IN LATER -typedef ^ MD_Fail IntKi IdNum - - - "integer identifier of this failure" - +# this is the Fail type, which holds data for possible line failure descriptors +typedef ^ MD_Fail IntKi IdNum - - - "integer identifier of this failure" "-" +typedef ^ ^ IntKi attachID - - - "ID of connection or Rod the lines are attached to" "-" +typedef ^ ^ IntKi isRod - - - "1 Rod end A, 2 Rod end B, 0 if point" "-" +typedef ^ ^ IntKi lineIDs {30} - - "array of one or more lines to detach (starting from 1...)" "-" +typedef ^ ^ IntKi lineTops {30} - - "an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" "-" +typedef ^ ^ IntKi nLinesToDetach - - - "how many lines to dettach" "-" +typedef ^ ^ IntKi nLinesToDetach - - - "time of failure" "s" +typedef ^ ^ IntKi nLinesToDetach - - - "tension threshold of failure" "N" +typedef ^ ^ IntKi failStatus - - - "0 not failed yet, 1 failed, 2 invalid" "-" # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" @@ -333,6 +340,7 @@ typedef ^ ^ IntKi RodStateIsN {:} typedef ^ ^ IntKi BodyStateIs1 {:} - - "starting index of each body's states in state vector" "" typedef ^ ^ IntKi BodyStateIsN {:} - - "ending index of each body's states in state vector" "" typedef ^ ^ IntKi Nx - - - "number of states and size of state vector" "" +typedef ^ ^ IntKi Nxtra - - - "number of states and size of state vector including points for potential line failures" "" typedef ^ ^ IntKi WaveTi - - - "current interpolation index for wave time series data" "" typedef ^ ^ MD_ContinuousStateType xTemp - - - "contains temporary state vector used in integration (put here so it's only allocated once)" typedef ^ ^ MD_ContinuousStateType xdTemp - - - "contains temporary state derivative vector used in integration (put here so it's only allocated once)" From 57761232c406edcbe85838604055c4178da672eb Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 13 May 2024 17:51:02 -0600 Subject: [PATCH 5/8] Updated registry and types, added warning for wave elevation profile --- modules/moordyn/src/MoorDyn.f90 | 4 +- modules/moordyn/src/MoorDyn_Misc.f90 | 4 + modules/moordyn/src/MoorDyn_Registry.txt | 4 +- modules/moordyn/src/MoorDyn_Types.f90 | 101 ++++++++++++++++++----- 4 files changed, 90 insertions(+), 23 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 35cd383e08..93e9dcc3e5 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -2909,7 +2909,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er m%FailList(li)%nLinesToDetach = m%FailList(li)%nLinesToDetach - 1 ! reduce the size of nLinesToDetach of the other failure m%FailList(li)%lineIDs(lii) = m%FailList(li)%lineIDs(lii+1) ! move subsequent line ID's forward one spot in the list to eliminate this line ID - CALL CheckError(ErrID_Warn, "Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" removed from Failure "//trim(num2lstr(li))//" becasue it already failed by Failure "//trim(num2lstr(l))) + CALL CheckError(ErrID_Warn, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" removed from Failure "//trim(num2lstr(li))//" becasue it already failed by Failure "//trim(num2lstr(l))) endif @@ -2919,7 +2919,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er if (m%FailList(li)%nLinesToDetach == 0) then ! invalid failure m%FailList(li)%failStatus = 2 - CALL CheckError (ErrID_Warn, "Failure "//trim(num2lstr(li))//" is a duplicate of failure "//trim(num2lstr(l))//" and will be ignored.") + CALL CheckError (ErrID_Warn, " Failure "//trim(num2lstr(li))//" is a duplicate of Failure "//trim(num2lstr(l))//" and will be ignored.") endif endif diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index c54dea1f2e..cfc82ed6f4 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1500,6 +1500,10 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! Close the inputs file CLOSE ( UnElev ) + + IF (WaveTimeIn(1) .NE. 0.0) THEN + CALL SetErrStat( ErrID_Warn, ' MoorDyn WaveElev time series should start at t = 0 seconds. First two lines are read as headers.',ErrStat, ErrMsg, RoutineName); return + ENDIF call WrScr( "Read "//trim(num2lstr(ntIn))//" time steps from input file." ) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index b9b26f60af..f2b509f9cf 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -272,8 +272,8 @@ typedef ^ ^ IntKi isRod - typedef ^ ^ IntKi lineIDs {30} - - "array of one or more lines to detach (starting from 1...)" "-" typedef ^ ^ IntKi lineTops {30} - - "an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" "-" typedef ^ ^ IntKi nLinesToDetach - - - "how many lines to dettach" "-" -typedef ^ ^ IntKi nLinesToDetach - - - "time of failure" "s" -typedef ^ ^ IntKi nLinesToDetach - - - "tension threshold of failure" "N" +typedef ^ ^ DbKi failTime - - - "time of failure" "s" +typedef ^ ^ DbKi failTen - - - "tension threshold of failure" "N" typedef ^ ^ IntKi failStatus - - - "0 not failed yet, 1 failed, 2 invalid" "-" # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 69a4418bf5..ecf3a22480 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -105,8 +105,8 @@ MODULE MoorDyn_Types TYPE, PUBLIC :: MD_Body INTEGER(IntKi) :: IdNum !< integer identifier of this Point [-] INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0 !< list of IdNums of points attached to this body [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0 !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of points attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR !< list of IdNums of rods attached to this body [-] INTEGER(IntKi) :: nAttachedC = 0 !< number of attached points [-] INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel !< relative position of point on body [-] @@ -136,8 +136,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: IdNum !< integer identifier of this point [-] CHARACTER(10) :: type !< type of point: fix, vessel, point [-] INTEGER(IntKi) :: typeNum !< integer identifying the type. 1=fixed, -1=coupled, 0=free [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0 !< list of IdNums of lines attached to this point node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0 !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this point node [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Top !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] REAL(DbKi) :: pointM !< point mass [[kg]] REAL(DbKi) :: pointV !< point volume [[m^3]] @@ -164,10 +164,10 @@ MODULE MoorDyn_Types CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated rod properties [-] INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0 !< list of IdNums of lines attached to end A [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0 !< list of IdNums of lines attached to end B [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0 !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0 !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopA !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopB !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] @@ -227,8 +227,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] - INTEGER(IntKi) :: FairPoint !< IdNum of Point at fairlead. Not initialized [-] - INTEGER(IntKi) :: AnchPoint !< IdNum of Point at anchor. Not initialized [-] + INTEGER(IntKi) :: FairPoint !< IdNum of Point at fairlead [-] + INTEGER(IntKi) :: AnchPoint !< IdNum of Point at anchor [-] INTEGER(IntKi) :: N !< The number of elements in the line [-] INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] @@ -289,15 +289,15 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_Fail ======= TYPE, PUBLIC :: MD_Fail - INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] - INTEGER(IntKi) :: attachID !< ID of connection or Rod the lines are attached to [-] - INTEGER(IntKi) :: isRod !< 1 Rod end A, 2 Rod end B, 0 if point [-] - INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs !< array of one or more lines to detach (starting from 1...) [-] - INTEGER(IntKi) , DIMENSION(1:30) :: lineTops !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nLinesToDetach !< how many lines to dettach [-] - REAL(DbKi) :: failTime !< time of failure [[s]] - REAL(DbKi) :: failTen !< tension threshold of failure [[N]] - INTEGER(IntKi) :: failStatus !< 0 not failed yet, 1 failed, 2 invalid [-] + INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + INTEGER(IntKi) :: attachID !< ID of connection or Rod the lines are attached to [-] + INTEGER(IntKi) :: isRod !< 1 Rod end A, 2 Rod end B, 0 if point [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs !< array of one or more lines to detach (starting from 1...) [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineTops !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nLinesToDetach !< how many lines to dettach [-] + REAL(DbKi) :: failTime !< time of failure [s] + REAL(DbKi) :: failTen !< tension threshold of failure [N] + INTEGER(IntKi) :: failStatus !< 0 not failed yet, 1 failed, 2 invalid [-] END TYPE MD_Fail ! ======================= ! ========= MD_OutParmType ======= @@ -6256,6 +6256,7 @@ SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: 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_CopyFail' @@ -6263,6 +6264,14 @@ SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" DstFailData%IdNum = SrcFailData%IdNum + DstFailData%attachID = SrcFailData%attachID + DstFailData%isRod = SrcFailData%isRod + DstFailData%lineIDs = SrcFailData%lineIDs + DstFailData%lineTops = SrcFailData%lineTops + DstFailData%nLinesToDetach = SrcFailData%nLinesToDetach + DstFailData%failTime = SrcFailData%failTime + DstFailData%failTen = SrcFailData%failTen + DstFailData%failStatus = SrcFailData%failStatus END SUBROUTINE MD_CopyFail SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -6324,6 +6333,14 @@ SUBROUTINE MD_PackFail( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_BufSz = 0 Int_BufSz = 0 Int_BufSz = Int_BufSz + 1 ! IdNum + Int_BufSz = Int_BufSz + 1 ! attachID + Int_BufSz = Int_BufSz + 1 ! isRod + Int_BufSz = Int_BufSz + SIZE(InData%lineIDs) ! lineIDs + Int_BufSz = Int_BufSz + SIZE(InData%lineTops) ! lineTops + Int_BufSz = Int_BufSz + 1 ! nLinesToDetach + Db_BufSz = Db_BufSz + 1 ! failTime + Db_BufSz = Db_BufSz + 1 ! failTen + Int_BufSz = Int_BufSz + 1 ! failStatus IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -6353,6 +6370,26 @@ SUBROUTINE MD_PackFail( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf(Int_Xferred) = InData%IdNum Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%attachID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%isRod + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%lineIDs,1), UBOUND(InData%lineIDs,1) + IntKiBuf(Int_Xferred) = InData%lineIDs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%lineTops,1), UBOUND(InData%lineTops,1) + IntKiBuf(Int_Xferred) = InData%lineTops(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nLinesToDetach + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%failTime + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%failTen + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%failStatus + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_PackFail SUBROUTINE MD_UnPackFail( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6368,6 +6405,7 @@ SUBROUTINE MD_UnPackFail( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred 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_UnPackFail' @@ -6383,6 +6421,30 @@ SUBROUTINE MD_UnPackFail( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Xferred = 1 OutData%IdNum = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%attachID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%isRod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%lineIDs,1) + i1_u = UBOUND(OutData%lineIDs,1) + DO i1 = LBOUND(OutData%lineIDs,1), UBOUND(OutData%lineIDs,1) + OutData%lineIDs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%lineTops,1) + i1_u = UBOUND(OutData%lineTops,1) + DO i1 = LBOUND(OutData%lineTops,1), UBOUND(OutData%lineTops,1) + OutData%lineTops(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%nLinesToDetach = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%failTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%failTen = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%failStatus = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_UnPackFail SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -8971,6 +9033,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIsN) ! BodyStateIsN END IF Int_BufSz = Int_BufSz + 1 ! Nx + Int_BufSz = Int_BufSz + 1 ! Nxtra Int_BufSz = Int_BufSz + 1 ! WaveTi Int_BufSz = Int_BufSz + 3 ! xTemp: size of buffers for each call to pack subtype CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xTemp From e5fe8082ce09fa5592c7217844da73ab53eb0a4d Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 13 May 2024 18:01:28 -0600 Subject: [PATCH 6/8] Cleaning up print statements --- modules/moordyn/src/MoorDyn_Body.f90 | 8 +++---- modules/moordyn/src/MoorDyn_Line.f90 | 6 +----- modules/moordyn/src/MoorDyn_Point.f90 | 30 +++++++++++---------------- modules/moordyn/src/MoorDyn_Rod.f90 | 6 +++--- 4 files changed, 20 insertions(+), 30 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index 9415030ed9..743c3c5791 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -286,7 +286,7 @@ SUBROUTINE Body_SetState(Body, X, t, m) CALL Body_SetDependentKin(Body, t, m) else - print *, "Error: Body::setState called for a non-free Body type in MoorDyn" ! <<< + Call WrScr("Error: Body::setState called for a non-free Body type in MoorDyn") ! <<< end if END SUBROUTINE Body_SetState @@ -490,7 +490,7 @@ SUBROUTINE Body_DoRHS(Body, m, p) CALL Point_GetNetForceAndMass( m%PointList(Body%attachedC(l)), Body%r6(1:3), F6_i, M6_i, m, p) if (ABS(F6_i(5)) > 1.0E12) then - print *, "Warning: extreme pitch moment from body-attached Point ", l + Call WrScr( "Warning: extreme pitch moment from body-attached Point "//trim(num2lstr(l))) end if ! sum quantitites @@ -505,7 +505,7 @@ SUBROUTINE Body_DoRHS(Body, m, p) CALL Rod_GetNetForceAndMass(m%RodList(Body%attachedR(l)), Body%r6(1:3), F6_i, M6_i, m, p) if (ABS(F6_i(5)) > 1.0E12) then - print *, "Warning: extreme pitch moment from body-attached Rod ", l + Call WrScr("Warning: extreme pitch moment from body-attached Rod "//trim(num2lstr(l))) end if ! sum quantitites @@ -559,7 +559,7 @@ SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) Fnet_out = Body%F6net else - print *, "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!" + Call WrScr( "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!") end if END SUBROUTINE Body_GetCoupledForce diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 index 190cc4d7eb..a6be2b217e 100644 --- a/modules/moordyn/src/MoorDyn_Line.f90 +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -357,12 +357,8 @@ SUBROUTINE Line_Initialize (Line, LineProp, p, ErrStat, ErrMsg) Line%r(2,J) = Line%r(2,0) + (Line%r(2,N) - Line%r(2,0))*REAL(J, DbKi)/REAL(N, DbKi) Line%r(3,J) = Line%r(3,0) + (Line%r(3,N) - Line%r(3,0))*REAL(J, DbKi)/REAL(N, DbKi) - ! print*, Line%r(:,J) ENDDO - ! print*,"FYI line end A and B node coords are" - ! print*, Line%r(:,0) - ! print*, Line%r(:,N) ENDIF ENDIF @@ -1464,7 +1460,7 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, ! check for NaNs DO J = 1, 6*(N-1) IF (Is_NaN(Xd(J))) THEN - print *, "NaN detected at time ", Line%time, " in Line ", Line%IdNum, " in MoorDyn." + Call WrScr( "NaN detected at time "//trim(num2lstr(Line%time))//" in Line "//trim(num2lstr(Line%IdNum))//" in MoorDyn.") IF (wordy > 1) THEN print *, "state derivatives:" print *, Xd diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 index dc0f233284..8f5d87f07f 100644 --- a/modules/moordyn/src/MoorDyn_Point.f90 +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -97,24 +97,18 @@ SUBROUTINE Point_SetKinematics(Point, r_in, rd_in, a_in, t, m) Point%time = t - ! if (Point%typeNum==0) THEN ! anchor ( <<< to be changed/expanded) ... in MoorDyn F also used for coupled points - - ! set position and velocity - Point%r = r_in - Point%rd = rd_in - Point%a = a_in - - ! pass latest kinematics to any attached lines - DO l=1,Point%nAttached - CALL Line_SetEndKinematics(m%LineList(Point%attached(l)), Point%r, Point%rd, t, Point%Top(l)) - END DO - - ! else - ! - ! PRINT*,"Error: setKinematics called for wrong Point type. Point ", Point%IdNum, " type ", Point%typeNum - - ! END IF - + + ! set position and velocity + Point%r = r_in + Point%rd = rd_in + Point%a = a_in + + ! pass latest kinematics to any attached lines + DO l=1,Point%nAttached + CALL Line_SetEndKinematics(m%LineList(Point%attached(l)), Point%r, Point%rd, t, Point%Top(l)) + END DO + + END SUBROUTINE Point_SetKinematics !-------------------------------------------------------------- diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index b5d51bc2d0..50bd217a0c 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -259,7 +259,7 @@ SUBROUTINE Rod_SetKinematics(Rod, r6_in, v6_in, a6_in, t, m) ! handled, along with passing kinematics to dependent lines, by separate call to setState else - print *, "Error: Rod_SetKinematics called for a free Rod in MoorDyn. Rod number", Rod%IdNum ! <<< + Call WrScr("Error: Rod_SetKinematics called for a free Rod in MoorDyn. Rod number"//trim(num2lstr(Rod%IdNum))) ! <<< end if @@ -324,7 +324,7 @@ SUBROUTINE Rod_SetState(Rod, X, t, m) CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) else - print *, "Error: Rod::setState called for a non-free rod type in MoorDyn" ! <<< + Call WrScr("Error: Rod::setState called for a non-free rod type in MoorDyn") ! <<< end if ! update Rod direction unit vector (simply equal to last three entries of r6) @@ -1018,7 +1018,7 @@ SUBROUTINE Rod_GetCoupledForce(Rod, Fnet_out, m, p) Rod%F6net(4:6) = 0.0_DbKi Fnet_out = Rod%F6net else - print *, "ERROR, Rod_GetCoupledForce called for wrong (non-coupled) rod type!" + Call WrScr("ERROR, Rod_GetCoupledForce called for wrong (non-coupled) rod type!") end if END SUBROUTINE Rod_GetCoupledForce From 250ff38fd2467817b0abaaec84dd4b650b07317e Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 16 May 2024 13:28:13 -0600 Subject: [PATCH 7/8] Updated Types --- modules/moordyn/src/MoorDyn_Types.f90 | 4498 +------------------------ 1 file changed, 87 insertions(+), 4411 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 76b5563f71..a9361da552 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -289,15 +289,15 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_Fail ======= TYPE, PUBLIC :: MD_Fail - INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] - INTEGER(IntKi) :: attachID !< ID of connection or Rod the lines are attached to [-] - INTEGER(IntKi) :: isRod !< 1 Rod end A, 2 Rod end B, 0 if point [-] - INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs !< array of one or more lines to detach (starting from 1...) [-] - INTEGER(IntKi) , DIMENSION(1:30) :: lineTops !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nLinesToDetach !< how many lines to dettach [-] - REAL(DbKi) :: failTime !< time of failure [s] - REAL(DbKi) :: failTen !< tension threshold of failure [N] - INTEGER(IntKi) :: failStatus !< 0 not failed yet, 1 failed, 2 invalid [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this failure [-] + INTEGER(IntKi) :: attachID = 0_IntKi !< ID of connection or Rod the lines are attached to [-] + INTEGER(IntKi) :: isRod = 0_IntKi !< 1 Rod end A, 2 Rod end B, 0 if point [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs = 0_IntKi !< array of one or more lines to detach (starting from 1...) [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineTops = 0_IntKi !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nLinesToDetach = 0_IntKi !< how many lines to dettach [-] + REAL(DbKi) :: failTime = 0.0_R8Ki !< time of failure [s] + REAL(DbKi) :: failTen = 0.0_R8Ki !< tension threshold of failure [N] + INTEGER(IntKi) :: failStatus = 0_IntKi !< 0 not failed yet, 1 failed, 2 invalid [-] END TYPE MD_Fail ! ======================= ! ========= MD_OutParmType ======= @@ -375,9 +375,9 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] - INTEGER(IntKi) :: Nx !< number of states and size of state vector [] - INTEGER(IntKi) :: Nxtra !< number of states and size of state vector including points for potential line failures [] - INTEGER(IntKi) :: WaveTi !< current interpolation index for wave time series data [] + INTEGER(IntKi) :: Nx = 0_IntKi !< number of states and size of state vector [] + INTEGER(IntKi) :: Nxtra = 0_IntKi !< number of states and size of state vector including points for potential line failures [] + INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] @@ -835,1897 +835,48 @@ subroutine MD_UnPackRodProp(RF, OutData) call RegUnpack(RF, OutData%CaEnd); if (RegCheckErr(RF, RoutineName)) return end subroutine - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(LineData%r)) THEN - DEALLOCATE(LineData%r) -ENDIF -IF (ALLOCATED(LineData%rd)) THEN - DEALLOCATE(LineData%rd) -ENDIF -IF (ALLOCATED(LineData%q)) THEN - DEALLOCATE(LineData%q) -ENDIF -IF (ALLOCATED(LineData%qs)) THEN - DEALLOCATE(LineData%qs) -ENDIF -IF (ALLOCATED(LineData%l)) THEN - DEALLOCATE(LineData%l) -ENDIF -IF (ALLOCATED(LineData%ld)) THEN - DEALLOCATE(LineData%ld) -ENDIF -IF (ALLOCATED(LineData%lstr)) THEN - DEALLOCATE(LineData%lstr) -ENDIF -IF (ALLOCATED(LineData%lstrd)) THEN - DEALLOCATE(LineData%lstrd) -ENDIF -IF (ALLOCATED(LineData%Kurv)) THEN - DEALLOCATE(LineData%Kurv) -ENDIF -IF (ALLOCATED(LineData%dl_1)) THEN - DEALLOCATE(LineData%dl_1) -ENDIF -IF (ALLOCATED(LineData%V)) THEN - DEALLOCATE(LineData%V) -ENDIF -IF (ALLOCATED(LineData%U)) THEN - DEALLOCATE(LineData%U) -ENDIF -IF (ALLOCATED(LineData%Ud)) THEN - DEALLOCATE(LineData%Ud) -ENDIF -IF (ALLOCATED(LineData%zeta)) THEN - DEALLOCATE(LineData%zeta) -ENDIF -IF (ALLOCATED(LineData%PDyn)) THEN - DEALLOCATE(LineData%PDyn) -ENDIF -IF (ALLOCATED(LineData%T)) THEN - DEALLOCATE(LineData%T) -ENDIF -IF (ALLOCATED(LineData%Td)) THEN - DEALLOCATE(LineData%Td) -ENDIF -IF (ALLOCATED(LineData%W)) THEN - DEALLOCATE(LineData%W) -ENDIF -IF (ALLOCATED(LineData%Dp)) THEN - DEALLOCATE(LineData%Dp) -ENDIF -IF (ALLOCATED(LineData%Dq)) THEN - DEALLOCATE(LineData%Dq) -ENDIF -IF (ALLOCATED(LineData%Ap)) THEN - DEALLOCATE(LineData%Ap) -ENDIF -IF (ALLOCATED(LineData%Aq)) THEN - DEALLOCATE(LineData%Aq) -ENDIF -IF (ALLOCATED(LineData%B)) THEN - DEALLOCATE(LineData%B) -ENDIF -IF (ALLOCATED(LineData%Bs)) THEN - DEALLOCATE(LineData%Bs) -ENDIF -IF (ALLOCATED(LineData%Fnet)) THEN - DEALLOCATE(LineData%Fnet) -ENDIF -IF (ALLOCATED(LineData%S)) THEN - DEALLOCATE(LineData%S) -ENDIF -IF (ALLOCATED(LineData%M)) THEN - DEALLOCATE(LineData%M) -ENDIF -IF (ALLOCATED(LineData%LineWrOutput)) THEN - DEALLOCATE(LineData%LineWrOutput) -ENDIF - END SUBROUTINE MD_DestroyLine - - SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Line), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLine' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! CtrlChan - Int_BufSz = Int_BufSz + 1 ! FairPoint - Int_BufSz = Int_BufSz + 1 ! AnchPoint - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - Db_BufSz = Db_BufSz + 1 ! time - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! qs allocated yes/no - IF ( ALLOCATED(InData%qs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! qs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qs) ! qs - END IF - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! ld allocated yes/no - IF ( ALLOCATED(InData%ld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ld upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ld) ! ld - END IF - Int_BufSz = Int_BufSz + 1 ! lstr allocated yes/no - IF ( ALLOCATED(InData%lstr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstr) ! lstr - END IF - Int_BufSz = Int_BufSz + 1 ! lstrd allocated yes/no - IF ( ALLOCATED(InData%lstrd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstrd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstrd) ! lstrd - END IF - Int_BufSz = Int_BufSz + 1 ! Kurv allocated yes/no - IF ( ALLOCATED(InData%Kurv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Kurv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Kurv) ! Kurv - END IF - Int_BufSz = Int_BufSz + 1 ! dl_1 allocated yes/no - IF ( ALLOCATED(InData%dl_1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dl_1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dl_1) ! dl_1 - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! T allocated yes/no - IF ( ALLOCATED(InData%T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T) ! T - END IF - Int_BufSz = Int_BufSz + 1 ! Td allocated yes/no - IF ( ALLOCATED(InData%Td) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Td upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Td) ! Td - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Bs allocated yes/no - IF ( ALLOCATED(InData%Bs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bs) ! Bs - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! S allocated yes/no - IF ( ALLOCATED(InData%S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentA) ! EndMomentA - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentB) ! EndMomentB - Int_BufSz = Int_BufSz + 1 ! LineUnOut - Int_BufSz = Int_BufSz + 1 ! LineWrOutput allocated yes/no - IF ( ALLOCATED(InData%LineWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%CtrlChan - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FairPoint - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnchPoint - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%qs,2), UBOUND(InData%qs,2) - DO i1 = LBOUND(InData%qs,1), UBOUND(InData%qs,1) - DbKiBuf(Db_Xferred) = InData%qs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) - DbKiBuf(Db_Xferred) = InData%ld(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) - DbKiBuf(Db_Xferred) = InData%lstr(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstrd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) - DbKiBuf(Db_Xferred) = InData%lstrd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kurv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kurv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kurv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Kurv,1), UBOUND(InData%Kurv,1) - DbKiBuf(Db_Xferred) = InData%Kurv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl_1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl_1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl_1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dl_1,1), UBOUND(InData%dl_1,1) - DbKiBuf(Db_Xferred) = InData%dl_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) - DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) - DbKiBuf(Db_Xferred) = InData%T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Td) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) - DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) - DbKiBuf(Db_Xferred) = InData%Td(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bs,2), UBOUND(InData%Bs,2) - DO i1 = LBOUND(InData%Bs,1), UBOUND(InData%Bs,1) - DbKiBuf(Db_Xferred) = InData%Bs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) - DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%EndMomentA,1), UBOUND(InData%EndMomentA,1) - DbKiBuf(Db_Xferred) = InData%EndMomentA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%EndMomentB,1), UBOUND(InData%EndMomentB,1) - DbKiBuf(Db_Xferred) = InData%EndMomentB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) - DbKiBuf(Db_Xferred) = InData%LineWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackLine - - SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Line), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLine' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%CtrlChan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FairPoint = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnchPoint = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qs)) DEALLOCATE(OutData%qs) - ALLOCATE(OutData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%qs,2), UBOUND(OutData%qs,2) - DO i1 = LBOUND(OutData%qs,1), UBOUND(OutData%qs,1) - OutData%qs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ld not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ld)) DEALLOCATE(OutData%ld) - ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ld,1), UBOUND(OutData%ld,1) - OutData%ld(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lstr)) DEALLOCATE(OutData%lstr) - ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) - OutData%lstr(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lstrd)) DEALLOCATE(OutData%lstrd) - ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) - OutData%lstrd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kurv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kurv)) DEALLOCATE(OutData%Kurv) - ALLOCATE(OutData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Kurv,1), UBOUND(OutData%Kurv,1) - OutData%Kurv(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl_1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dl_1)) DEALLOCATE(OutData%dl_1) - ALLOCATE(OutData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dl_1,1), UBOUND(OutData%dl_1,1) - OutData%dl_1(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T)) DEALLOCATE(OutData%T) - ALLOCATE(OutData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) - DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) - OutData%T(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Td)) DEALLOCATE(OutData%Td) - ALLOCATE(OutData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) - DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) - OutData%Td(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Bs)) DEALLOCATE(OutData%Bs) - ALLOCATE(OutData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bs,2), UBOUND(OutData%Bs,2) - DO i1 = LBOUND(OutData%Bs,1), UBOUND(OutData%Bs,1) - OutData%Bs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%S)) DEALLOCATE(OutData%S) - ALLOCATE(OutData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EndMomentA,1) - i1_u = UBOUND(OutData%EndMomentA,1) - DO i1 = LBOUND(OutData%EndMomentA,1), UBOUND(OutData%EndMomentA,1) - OutData%EndMomentA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EndMomentB,1) - i1_u = UBOUND(OutData%EndMomentB,1) - DO i1 = LBOUND(OutData%EndMomentB,1), UBOUND(OutData%EndMomentB,1) - OutData%EndMomentB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%LineUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) - ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) - OutData%LineWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackLine - - SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(IN) :: SrcFailData - TYPE(MD_Fail), INTENT(INOUT) :: DstFailData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyFail' -! +subroutine MD_CopyBody(SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg) + type(MD_Body), intent(in) :: SrcBodyData + type(MD_Body), intent(inout) :: DstBodyData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyBody' ErrStat = ErrID_None - ErrMsg = "" - DstFailData%IdNum = SrcFailData%IdNum - DstFailData%attachID = SrcFailData%attachID - DstFailData%isRod = SrcFailData%isRod - DstFailData%lineIDs = SrcFailData%lineIDs - DstFailData%lineTops = SrcFailData%lineTops - DstFailData%nLinesToDetach = SrcFailData%nLinesToDetach - DstFailData%failTime = SrcFailData%failTime - DstFailData%failTen = SrcFailData%failTen - DstFailData%failStatus = SrcFailData%failStatus - END SUBROUTINE MD_CopyFail - - SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Fail), INTENT(INOUT) :: FailData - 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_DestroyFail' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyFail - - SUBROUTINE MD_PackFail( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Fail), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackFail' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1 ! attachID - Int_BufSz = Int_BufSz + 1 ! isRod - Int_BufSz = Int_BufSz + SIZE(InData%lineIDs) ! lineIDs - Int_BufSz = Int_BufSz + SIZE(InData%lineTops) ! lineTops - Int_BufSz = Int_BufSz + 1 ! nLinesToDetach - Db_BufSz = Db_BufSz + 1 ! failTime - Db_BufSz = Db_BufSz + 1 ! failTen - Int_BufSz = Int_BufSz + 1 ! failStatus - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%attachID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%isRod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%lineIDs,1), UBOUND(InData%lineIDs,1) - IntKiBuf(Int_Xferred) = InData%lineIDs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%lineTops,1), UBOUND(InData%lineTops,1) - IntKiBuf(Int_Xferred) = InData%lineTops(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nLinesToDetach - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%failTime - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%failTen - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%failStatus - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackFail - - SUBROUTINE MD_UnPackFail( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Fail), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackFail' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%attachID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%isRod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%lineIDs,1) - i1_u = UBOUND(OutData%lineIDs,1) - DO i1 = LBOUND(OutData%lineIDs,1), UBOUND(OutData%lineIDs,1) - OutData%lineIDs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%lineTops,1) - i1_u = UBOUND(OutData%lineTops,1) - DO i1 = LBOUND(OutData%lineTops,1), UBOUND(OutData%lineTops,1) - OutData%lineTops(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nLinesToDetach = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%failTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%failTen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%failStatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackFail + ErrMsg = '' + DstBodyData%IdNum = SrcBodyData%IdNum + DstBodyData%typeNum = SrcBodyData%typeNum + DstBodyData%AttachedC = SrcBodyData%AttachedC + DstBodyData%AttachedR = SrcBodyData%AttachedR + DstBodyData%nAttachedC = SrcBodyData%nAttachedC + DstBodyData%nAttachedR = SrcBodyData%nAttachedR + DstBodyData%rPointRel = SrcBodyData%rPointRel + DstBodyData%r6RodRel = SrcBodyData%r6RodRel + DstBodyData%bodyM = SrcBodyData%bodyM + DstBodyData%bodyV = SrcBodyData%bodyV + DstBodyData%bodyI = SrcBodyData%bodyI + DstBodyData%bodyCdA = SrcBodyData%bodyCdA + DstBodyData%bodyCa = SrcBodyData%bodyCa + DstBodyData%time = SrcBodyData%time + DstBodyData%r6 = SrcBodyData%r6 + DstBodyData%v6 = SrcBodyData%v6 + DstBodyData%a6 = SrcBodyData%a6 + DstBodyData%U = SrcBodyData%U + DstBodyData%Ud = SrcBodyData%Ud + DstBodyData%zeta = SrcBodyData%zeta + DstBodyData%F6net = SrcBodyData%F6net + DstBodyData%M6net = SrcBodyData%M6net + DstBodyData%M = SrcBodyData%M + DstBodyData%M0 = SrcBodyData%M0 + DstBodyData%OrMat = SrcBodyData%OrMat + DstBodyData%rCG = SrcBodyData%rCG +end subroutine - SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOutParmType' -! +subroutine MD_DestroyBody(BodyData, ErrStat, ErrMsg) + type(MD_Body), intent(inout) :: BodyData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyBody' ErrStat = ErrID_None ErrMsg = '' end subroutine @@ -4029,2517 +2180,23 @@ subroutine MD_CopyFail(SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg character(*), parameter :: RoutineName = 'MD_CopyFail' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LineTypeList)) THEN - i1_l = LBOUND(SrcMiscData%LineTypeList,1) - i1_u = UBOUND(SrcMiscData%LineTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineTypeList)) THEN - ALLOCATE(DstMiscData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineTypeList,1), UBOUND(SrcMiscData%LineTypeList,1) - CALL MD_Copylineprop( SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodTypeList)) THEN - i1_l = LBOUND(SrcMiscData%RodTypeList,1) - i1_u = UBOUND(SrcMiscData%RodTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodTypeList)) THEN - ALLOCATE(DstMiscData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodTypeList,1), UBOUND(SrcMiscData%RodTypeList,1) - CALL MD_Copyrodprop( SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_Copybody( SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%BodyList)) THEN - i1_l = LBOUND(SrcMiscData%BodyList,1) - i1_u = UBOUND(SrcMiscData%BodyList,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyList)) THEN - ALLOCATE(DstMiscData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BodyList,1), UBOUND(SrcMiscData%BodyList,1) - CALL MD_Copybody( SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodList)) THEN - i1_l = LBOUND(SrcMiscData%RodList,1) - i1_u = UBOUND(SrcMiscData%RodList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodList)) THEN - ALLOCATE(DstMiscData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodList,1), UBOUND(SrcMiscData%RodList,1) - CALL MD_Copyrod( SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%PointList)) THEN - i1_l = LBOUND(SrcMiscData%PointList,1) - i1_u = UBOUND(SrcMiscData%PointList,1) - IF (.NOT. ALLOCATED(DstMiscData%PointList)) THEN - ALLOCATE(DstMiscData%PointList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%PointList,1), UBOUND(SrcMiscData%PointList,1) - CALL MD_Copypoint( SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%LineList)) THEN - i1_l = LBOUND(SrcMiscData%LineList,1) - i1_u = UBOUND(SrcMiscData%LineList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineList)) THEN - ALLOCATE(DstMiscData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineList,1), UBOUND(SrcMiscData%LineList,1) - CALL MD_Copyline( SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FailList)) THEN - i1_l = LBOUND(SrcMiscData%FailList,1) - i1_u = UBOUND(SrcMiscData%FailList,1) - IF (.NOT. ALLOCATED(DstMiscData%FailList)) THEN - ALLOCATE(DstMiscData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FailList,1), UBOUND(SrcMiscData%FailList,1) - CALL MD_Copyfail( SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FreePointIs)) THEN - i1_l = LBOUND(SrcMiscData%FreePointIs,1) - i1_u = UBOUND(SrcMiscData%FreePointIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreePointIs)) THEN - ALLOCATE(DstMiscData%FreePointIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreePointIs = SrcMiscData%FreePointIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldPointIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldPointIs,1) - i1_u = UBOUND(SrcMiscData%CpldPointIs,1) - i2_l = LBOUND(SrcMiscData%CpldPointIs,2) - i2_u = UBOUND(SrcMiscData%CpldPointIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldPointIs)) THEN - ALLOCATE(DstMiscData%CpldPointIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldPointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeRodIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeRodIs,1) - i1_u = UBOUND(SrcMiscData%FreeRodIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeRodIs)) THEN - ALLOCATE(DstMiscData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldRodIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldRodIs,1) - i1_u = UBOUND(SrcMiscData%CpldRodIs,1) - i2_l = LBOUND(SrcMiscData%CpldRodIs,2) - i2_u = UBOUND(SrcMiscData%CpldRodIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldRodIs)) THEN - ALLOCATE(DstMiscData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeBodyIs,1) - i1_u = UBOUND(SrcMiscData%FreeBodyIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeBodyIs)) THEN - ALLOCATE(DstMiscData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldBodyIs,1) - i1_u = UBOUND(SrcMiscData%CpldBodyIs,1) - i2_l = LBOUND(SrcMiscData%CpldBodyIs,2) - i2_u = UBOUND(SrcMiscData%CpldBodyIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldBodyIs)) THEN - ALLOCATE(DstMiscData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIs1,1) - i1_u = UBOUND(SrcMiscData%LineStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIs1)) THEN - ALLOCATE(DstMiscData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIsN,1) - i1_u = UBOUND(SrcMiscData%LineStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIsN)) THEN - ALLOCATE(DstMiscData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%PointStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%PointStateIs1,1) - i1_u = UBOUND(SrcMiscData%PointStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%PointStateIs1)) THEN - ALLOCATE(DstMiscData%PointStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%PointStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%PointStateIsN,1) - i1_u = UBOUND(SrcMiscData%PointStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%PointStateIsN)) THEN - ALLOCATE(DstMiscData%PointStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIs1,1) - i1_u = UBOUND(SrcMiscData%RodStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIs1)) THEN - ALLOCATE(DstMiscData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIsN,1) - i1_u = UBOUND(SrcMiscData%RodStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIsN)) THEN - ALLOCATE(DstMiscData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIs1,1) - i1_u = UBOUND(SrcMiscData%BodyStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIs1)) THEN - ALLOCATE(DstMiscData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIsN,1) - i1_u = UBOUND(SrcMiscData%BodyStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIsN)) THEN - ALLOCATE(DstMiscData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN -ENDIF - DstMiscData%Nx = SrcMiscData%Nx - DstMiscData%Nxtra = SrcMiscData%Nxtra - DstMiscData%WaveTi = SrcMiscData%WaveTi - CALL MD_CopyContState( SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyContState( SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%zeros6 = SrcMiscData%zeros6 -IF (ALLOCATED(SrcMiscData%MDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%MDWrOutput,1) - i1_u = UBOUND(SrcMiscData%MDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%MDWrOutput)) THEN - ALLOCATE(DstMiscData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit -IF (ALLOCATED(SrcMiscData%BathymetryGrid)) THEN - i1_l = LBOUND(SrcMiscData%BathymetryGrid,1) - i1_u = UBOUND(SrcMiscData%BathymetryGrid,1) - i2_l = LBOUND(SrcMiscData%BathymetryGrid,2) - i2_u = UBOUND(SrcMiscData%BathymetryGrid,2) - IF (.NOT. ALLOCATED(DstMiscData%BathymetryGrid)) THEN - ALLOCATE(DstMiscData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Xs)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Xs,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Xs,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Xs)) THEN - ALLOCATE(DstMiscData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Ys)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Ys,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Ys,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Ys)) THEN - ALLOCATE(DstMiscData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_npoints)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_npoints,1) - i1_u = UBOUND(SrcMiscData%BathGrid_npoints,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_npoints)) THEN - ALLOCATE(DstMiscData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints -ENDIF - END SUBROUTINE MD_CopyMisc - - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%LineTypeList)) THEN -DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - CALL MD_Destroylineprop( MiscData%LineTypeList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineTypeList) -ENDIF -IF (ALLOCATED(MiscData%RodTypeList)) THEN -DO i1 = LBOUND(MiscData%RodTypeList,1), UBOUND(MiscData%RodTypeList,1) - CALL MD_Destroyrodprop( MiscData%RodTypeList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodTypeList) -ENDIF - CALL MD_Destroybody( MiscData%GroundBody, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%BodyList)) THEN -DO i1 = LBOUND(MiscData%BodyList,1), UBOUND(MiscData%BodyList,1) - CALL MD_Destroybody( MiscData%BodyList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%BodyList) -ENDIF -IF (ALLOCATED(MiscData%RodList)) THEN -DO i1 = LBOUND(MiscData%RodList,1), UBOUND(MiscData%RodList,1) - CALL MD_Destroyrod( MiscData%RodList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodList) -ENDIF -IF (ALLOCATED(MiscData%PointList)) THEN -DO i1 = LBOUND(MiscData%PointList,1), UBOUND(MiscData%PointList,1) - CALL MD_Destroypoint( MiscData%PointList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%PointList) -ENDIF -IF (ALLOCATED(MiscData%LineList)) THEN -DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) - CALL MD_Destroyline( MiscData%LineList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineList) -ENDIF -IF (ALLOCATED(MiscData%FailList)) THEN -DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) - CALL MD_Destroyfail( MiscData%FailList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FailList) -ENDIF -IF (ALLOCATED(MiscData%FreePointIs)) THEN - DEALLOCATE(MiscData%FreePointIs) -ENDIF -IF (ALLOCATED(MiscData%CpldPointIs)) THEN - DEALLOCATE(MiscData%CpldPointIs) -ENDIF -IF (ALLOCATED(MiscData%FreeRodIs)) THEN - DEALLOCATE(MiscData%FreeRodIs) -ENDIF -IF (ALLOCATED(MiscData%CpldRodIs)) THEN - DEALLOCATE(MiscData%CpldRodIs) -ENDIF -IF (ALLOCATED(MiscData%FreeBodyIs)) THEN - DEALLOCATE(MiscData%FreeBodyIs) -ENDIF -IF (ALLOCATED(MiscData%CpldBodyIs)) THEN - DEALLOCATE(MiscData%CpldBodyIs) -ENDIF -IF (ALLOCATED(MiscData%LineStateIs1)) THEN - DEALLOCATE(MiscData%LineStateIs1) -ENDIF -IF (ALLOCATED(MiscData%LineStateIsN)) THEN - DEALLOCATE(MiscData%LineStateIsN) -ENDIF -IF (ALLOCATED(MiscData%PointStateIs1)) THEN - DEALLOCATE(MiscData%PointStateIs1) -ENDIF -IF (ALLOCATED(MiscData%PointStateIsN)) THEN - DEALLOCATE(MiscData%PointStateIsN) -ENDIF -IF (ALLOCATED(MiscData%RodStateIs1)) THEN - DEALLOCATE(MiscData%RodStateIs1) -ENDIF -IF (ALLOCATED(MiscData%RodStateIsN)) THEN - DEALLOCATE(MiscData%RodStateIsN) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIs1)) THEN - DEALLOCATE(MiscData%BodyStateIs1) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIsN)) THEN - DEALLOCATE(MiscData%BodyStateIsN) -ENDIF - CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%BathymetryGrid)) THEN - DEALLOCATE(MiscData%BathymetryGrid) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN - DEALLOCATE(MiscData%BathGrid_Xs) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN - DEALLOCATE(MiscData%BathGrid_Ys) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN - DEALLOCATE(MiscData%BathGrid_npoints) -ENDIF - END SUBROUTINE MD_DestroyMisc - - SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LineTypeList allocated yes/no - IF ( ALLOCATED(InData%LineTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineTypeList upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - Int_BufSz = Int_BufSz + 3 ! LineTypeList: size of buffers for each call to pack subtype - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodTypeList allocated yes/no - IF ( ALLOCATED(InData%RodTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodTypeList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - Int_BufSz = Int_BufSz + 3 ! RodTypeList: size of buffers for each call to pack subtype - CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! GroundBody: size of buffers for each call to pack subtype - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, .TRUE. ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GroundBody - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GroundBody - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GroundBody - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BodyList allocated yes/no - IF ( ALLOCATED(InData%BodyList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - Int_BufSz = Int_BufSz + 3 ! BodyList: size of buffers for each call to pack subtype - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BodyList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BodyList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BodyList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodList allocated yes/no - IF ( ALLOCATED(InData%RodList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - Int_BufSz = Int_BufSz + 3 ! RodList: size of buffers for each call to pack subtype - CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! PointList allocated yes/no - IF ( ALLOCATED(InData%PointList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PointList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%PointList,1), UBOUND(InData%PointList,1) - Int_BufSz = Int_BufSz + 3 ! PointList: size of buffers for each call to pack subtype - CALL MD_Packpoint( Re_Buf, Db_Buf, Int_Buf, InData%PointList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! PointList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LineList allocated yes/no - IF ( ALLOCATED(InData%LineList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - Int_BufSz = Int_BufSz + 3 ! LineList: size of buffers for each call to pack subtype - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FailList allocated yes/no - IF ( ALLOCATED(InData%FailList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FailList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - Int_BufSz = Int_BufSz + 3 ! FailList: size of buffers for each call to pack subtype - CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FailList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FailList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FailList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FreePointIs allocated yes/no - IF ( ALLOCATED(InData%FreePointIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreePointIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreePointIs) ! FreePointIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldPointIs allocated yes/no - IF ( ALLOCATED(InData%CpldPointIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldPointIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldPointIs) ! CpldPointIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeRodIs allocated yes/no - IF ( ALLOCATED(InData%FreeRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeRodIs) ! FreeRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldRodIs allocated yes/no - IF ( ALLOCATED(InData%CpldRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldRodIs) ! CpldRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeBodyIs allocated yes/no - IF ( ALLOCATED(InData%FreeBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeBodyIs) ! FreeBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldBodyIs allocated yes/no - IF ( ALLOCATED(InData%CpldBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldBodyIs) ! CpldBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIs1 allocated yes/no - IF ( ALLOCATED(InData%LineStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIs1) ! LineStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIsN allocated yes/no - IF ( ALLOCATED(InData%LineStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIsN) ! LineStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! PointStateIs1 allocated yes/no - IF ( ALLOCATED(InData%PointStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PointStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PointStateIs1) ! PointStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! PointStateIsN allocated yes/no - IF ( ALLOCATED(InData%PointStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PointStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PointStateIsN) ! PointStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIs1 allocated yes/no - IF ( ALLOCATED(InData%RodStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIs1) ! RodStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIsN allocated yes/no - IF ( ALLOCATED(InData%RodStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIsN) ! RodStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIs1 allocated yes/no - IF ( ALLOCATED(InData%BodyStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIs1) ! BodyStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIsN allocated yes/no - IF ( ALLOCATED(InData%BodyStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIsN) ! BodyStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! Nx - Int_BufSz = Int_BufSz + 1 ! Nxtra - Int_BufSz = Int_BufSz + 1 ! WaveTi - Int_BufSz = Int_BufSz + 3 ! xTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xdTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%zeros6) ! zeros6 - Int_BufSz = Int_BufSz + 1 ! MDWrOutput allocated yes/no - IF ( ALLOCATED(InData%MDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MDWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! BathymetryGrid allocated yes/no - IF ( ALLOCATED(InData%BathymetryGrid) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BathymetryGrid upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathymetryGrid) ! BathymetryGrid - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Xs allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Xs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Xs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Xs) ! BathGrid_Xs - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Ys allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Ys) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Ys upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Ys) ! BathGrid_Ys - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_npoints allocated yes/no - IF ( ALLOCATED(InData%BathGrid_npoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_npoints upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BathGrid_npoints) ! BathGrid_npoints - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LineTypeList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodTypeList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodTypeList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, OnlySize ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BodyList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, OnlySize ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PointList,1), UBOUND(InData%PointList,1) - CALL MD_Packpoint( Re_Buf, Db_Buf, Int_Buf, InData%PointList(i1), ErrStat2, ErrMsg2, OnlySize ) ! PointList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FailList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FailList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FailList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, OnlySize ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreePointIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreePointIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreePointIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreePointIs,1), UBOUND(InData%FreePointIs,1) - IntKiBuf(Int_Xferred) = InData%FreePointIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldPointIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldPointIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldPointIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldPointIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldPointIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldPointIs,2), UBOUND(InData%CpldPointIs,2) - DO i1 = LBOUND(InData%CpldPointIs,1), UBOUND(InData%CpldPointIs,1) - IntKiBuf(Int_Xferred) = InData%CpldPointIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeRodIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeRodIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeRodIs,1), UBOUND(InData%FreeRodIs,1) - IntKiBuf(Int_Xferred) = InData%FreeRodIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldRodIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldRodIs,2), UBOUND(InData%CpldRodIs,2) - DO i1 = LBOUND(InData%CpldRodIs,1), UBOUND(InData%CpldRodIs,1) - IntKiBuf(Int_Xferred) = InData%CpldRodIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeBodyIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeBodyIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeBodyIs,1), UBOUND(InData%FreeBodyIs,1) - IntKiBuf(Int_Xferred) = InData%FreeBodyIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldBodyIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldBodyIs,2), UBOUND(InData%CpldBodyIs,2) - DO i1 = LBOUND(InData%CpldBodyIs,1), UBOUND(InData%CpldBodyIs,1) - IntKiBuf(Int_Xferred) = InData%CpldBodyIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIs1,1), UBOUND(InData%LineStateIs1,1) - IntKiBuf(Int_Xferred) = InData%LineStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIsN,1), UBOUND(InData%LineStateIsN,1) - IntKiBuf(Int_Xferred) = InData%LineStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PointStateIs1,1), UBOUND(InData%PointStateIs1,1) - IntKiBuf(Int_Xferred) = InData%PointStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PointStateIsN,1), UBOUND(InData%PointStateIsN,1) - IntKiBuf(Int_Xferred) = InData%PointStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIs1,1), UBOUND(InData%RodStateIs1,1) - IntKiBuf(Int_Xferred) = InData%RodStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIsN,1), UBOUND(InData%RodStateIsN,1) - IntKiBuf(Int_Xferred) = InData%RodStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIs1,1), UBOUND(InData%BodyStateIs1,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIsN,1), UBOUND(InData%BodyStateIsN,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Nxtra - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveTi - Int_Xferred = Int_Xferred + 1 - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, OnlySize ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, OnlySize ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%zeros6,1), UBOUND(InData%zeros6,1) - DbKiBuf(Db_Xferred) = InData%zeros6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) - DbKiBuf(Db_Xferred) = InData%MDWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BathymetryGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BathymetryGrid,2), UBOUND(InData%BathymetryGrid,2) - DO i1 = LBOUND(InData%BathymetryGrid,1), UBOUND(InData%BathymetryGrid,1) - DbKiBuf(Db_Xferred) = InData%BathymetryGrid(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Xs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Xs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Xs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Xs,1), UBOUND(InData%BathGrid_Xs,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Xs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Ys) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Ys,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Ys,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Ys,1), UBOUND(InData%BathGrid_Ys,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Ys(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_npoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_npoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_npoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_npoints,1), UBOUND(InData%BathGrid_npoints,1) - IntKiBuf(Int_Xferred) = InData%BathGrid_npoints(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackMisc - - SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineTypeList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineTypeList)) DEALLOCATE(OutData%LineTypeList) - ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpacklineprop( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodTypeList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodTypeList)) DEALLOCATE(OutData%RodTypeList) - ALLOCATE(OutData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodTypeList,1), UBOUND(OutData%RodTypeList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackrodprop( Re_Buf, Db_Buf, Int_Buf, OutData%RodTypeList(i1), ErrStat2, ErrMsg2 ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BodyList)) DEALLOCATE(OutData%BodyList) - ALLOCATE(OutData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyList,1), UBOUND(OutData%BodyList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%BodyList(i1), ErrStat2, ErrMsg2 ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodList)) DEALLOCATE(OutData%RodList) - ALLOCATE(OutData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodList,1), UBOUND(OutData%RodList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackrod( Re_Buf, Db_Buf, Int_Buf, OutData%RodList(i1), ErrStat2, ErrMsg2 ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PointList)) DEALLOCATE(OutData%PointList) - ALLOCATE(OutData%PointList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PointList,1), UBOUND(OutData%PointList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_Unpackpoint( Re_Buf, Db_Buf, Int_Buf, OutData%PointList(i1), ErrStat2, ErrMsg2 ) ! PointList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineList)) DEALLOCATE(OutData%LineList) - ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineList,1), UBOUND(OutData%LineList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackline( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FailList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FailList)) DEALLOCATE(OutData%FailList) - ALLOCATE(OutData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FailList,1), UBOUND(OutData%FailList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackfail( Re_Buf, Db_Buf, Int_Buf, OutData%FailList(i1), ErrStat2, ErrMsg2 ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreePointIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreePointIs)) DEALLOCATE(OutData%FreePointIs) - ALLOCATE(OutData%FreePointIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreePointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreePointIs,1), UBOUND(OutData%FreePointIs,1) - OutData%FreePointIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldPointIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CpldPointIs)) DEALLOCATE(OutData%CpldPointIs) - ALLOCATE(OutData%CpldPointIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldPointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldPointIs,2), UBOUND(OutData%CpldPointIs,2) - DO i1 = LBOUND(OutData%CpldPointIs,1), UBOUND(OutData%CpldPointIs,1) - OutData%CpldPointIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeRodIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreeRodIs)) DEALLOCATE(OutData%FreeRodIs) - ALLOCATE(OutData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeRodIs,1), UBOUND(OutData%FreeRodIs,1) - OutData%FreeRodIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldRodIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CpldRodIs)) DEALLOCATE(OutData%CpldRodIs) - ALLOCATE(OutData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldRodIs,2), UBOUND(OutData%CpldRodIs,2) - DO i1 = LBOUND(OutData%CpldRodIs,1), UBOUND(OutData%CpldRodIs,1) - OutData%CpldRodIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeBodyIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreeBodyIs)) DEALLOCATE(OutData%FreeBodyIs) - ALLOCATE(OutData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeBodyIs,1), UBOUND(OutData%FreeBodyIs,1) - OutData%FreeBodyIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldBodyIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CpldBodyIs)) DEALLOCATE(OutData%CpldBodyIs) - ALLOCATE(OutData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldBodyIs,2), UBOUND(OutData%CpldBodyIs,2) - DO i1 = LBOUND(OutData%CpldBodyIs,1), UBOUND(OutData%CpldBodyIs,1) - OutData%CpldBodyIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineStateIs1)) DEALLOCATE(OutData%LineStateIs1) - ALLOCATE(OutData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIs1,1), UBOUND(OutData%LineStateIs1,1) - OutData%LineStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineStateIsN)) DEALLOCATE(OutData%LineStateIsN) - ALLOCATE(OutData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIsN,1), UBOUND(OutData%LineStateIsN,1) - OutData%LineStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PointStateIs1)) DEALLOCATE(OutData%PointStateIs1) - ALLOCATE(OutData%PointStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PointStateIs1,1), UBOUND(OutData%PointStateIs1,1) - OutData%PointStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PointStateIsN)) DEALLOCATE(OutData%PointStateIsN) - ALLOCATE(OutData%PointStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PointStateIsN,1), UBOUND(OutData%PointStateIsN,1) - OutData%PointStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodStateIs1)) DEALLOCATE(OutData%RodStateIs1) - ALLOCATE(OutData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIs1,1), UBOUND(OutData%RodStateIs1,1) - OutData%RodStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodStateIsN)) DEALLOCATE(OutData%RodStateIsN) - ALLOCATE(OutData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIsN,1), UBOUND(OutData%RodStateIsN,1) - OutData%RodStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BodyStateIs1)) DEALLOCATE(OutData%BodyStateIs1) - ALLOCATE(OutData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIs1,1), UBOUND(OutData%BodyStateIs1,1) - OutData%BodyStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BodyStateIsN)) DEALLOCATE(OutData%BodyStateIsN) - ALLOCATE(OutData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIsN,1), UBOUND(OutData%BodyStateIsN,1) - OutData%BodyStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Nxtra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTi = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xTemp, ErrStat2, ErrMsg2 ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdTemp, ErrStat2, ErrMsg2 ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%zeros6,1) - i1_u = UBOUND(OutData%zeros6,1) - DO i1 = LBOUND(OutData%zeros6,1), UBOUND(OutData%zeros6,1) - OutData%zeros6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) - ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) - OutData%MDWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathymetryGrid not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathymetryGrid)) DEALLOCATE(OutData%BathymetryGrid) - ALLOCATE(OutData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BathymetryGrid,2), UBOUND(OutData%BathymetryGrid,2) - DO i1 = LBOUND(OutData%BathymetryGrid,1), UBOUND(OutData%BathymetryGrid,1) - OutData%BathymetryGrid(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Xs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathGrid_Xs)) DEALLOCATE(OutData%BathGrid_Xs) - ALLOCATE(OutData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Xs,1), UBOUND(OutData%BathGrid_Xs,1) - OutData%BathGrid_Xs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Ys not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathGrid_Ys)) DEALLOCATE(OutData%BathGrid_Ys) - ALLOCATE(OutData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Ys,1), UBOUND(OutData%BathGrid_Ys,1) - OutData%BathGrid_Ys(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_npoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathGrid_npoints)) DEALLOCATE(OutData%BathGrid_npoints) - ALLOCATE(OutData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_npoints,1), UBOUND(OutData%BathGrid_npoints,1) - OutData%BathGrid_npoints(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackMisc + ErrMsg = '' + DstFailData%IdNum = SrcFailData%IdNum + DstFailData%attachID = SrcFailData%attachID + DstFailData%isRod = SrcFailData%isRod + DstFailData%lineIDs = SrcFailData%lineIDs + DstFailData%lineTops = SrcFailData%lineTops + DstFailData%nLinesToDetach = SrcFailData%nLinesToDetach + DstFailData%failTime = SrcFailData%failTime + DstFailData%failTen = SrcFailData%failTen + DstFailData%failStatus = SrcFailData%failStatus +end subroutine - SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' -! +subroutine MD_DestroyFail(FailData, ErrStat, ErrMsg) + type(MD_Fail), intent(inout) :: FailData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyFail' ErrStat = ErrID_None ErrMsg = '' end subroutine @@ -6550,6 +2207,14 @@ subroutine MD_PackFail(RF, Indata) character(*), parameter :: RoutineName = 'MD_PackFail' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%attachID) + call RegPack(RF, InData%isRod) + call RegPack(RF, InData%lineIDs) + call RegPack(RF, InData%lineTops) + call RegPack(RF, InData%nLinesToDetach) + call RegPack(RF, InData%failTime) + call RegPack(RF, InData%failTen) + call RegPack(RF, InData%failStatus) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -6559,6 +2224,14 @@ subroutine MD_UnPackFail(RF, OutData) character(*), parameter :: RoutineName = 'MD_UnPackFail' if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%attachID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%isRod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lineIDs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lineTops); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLinesToDetach); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%failTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%failTen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%failStatus); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) @@ -7376,6 +3049,7 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN end if DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%Nxtra = SrcMiscData%Nxtra DstMiscData%WaveTi = SrcMiscData%WaveTi call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7673,6 +3347,7 @@ subroutine MD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%BodyStateIs1) call RegPackAlloc(RF, InData%BodyStateIsN) call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxtra) call RegPack(RF, InData%WaveTi) call MD_PackContState(RF, InData%xTemp) call MD_PackContState(RF, InData%xdTemp) @@ -7803,6 +3478,7 @@ subroutine MD_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%BodyStateIs1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BodyStateIsN); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxtra); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveTi); if (RegCheckErr(RF, RoutineName)) return call MD_UnpackContState(RF, OutData%xTemp) ! xTemp call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp From dddeaf677fb6ce9947110e014f0b098c5c9028a5 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 16 May 2024 16:00:10 -0600 Subject: [PATCH 8/8] MD: add line failure regression test --- reg_tests/CTestList.cmake | 1 + reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 07b182092d..769810a590 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -468,6 +468,7 @@ seast_regression("seastate_wavemod5" "seastate") # pla # MoorDyn regression tests md_regression("md_5MW_OC4Semi" "moordyn") +md_regression("md_lineFail" "moordyn") py_md_regression("py_md_5MW_OC4Semi" "moordyn;python") # the following tests are excessively slow in double precision, so skip these in normal testing #md_regression("md_Node_Check_N20" "moordyn") diff --git a/reg_tests/r-test b/reg_tests/r-test index 3210b20016..c2c1f07c99 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 3210b20016c5319ff1b0c8fa7b41cdf4af5da871 +Subproject commit c2c1f07c99eaeb4572c9a51579514302f3212a5b